2024年4月10日发(作者：)

一、操作方法

将所有要合并的工作簿存放到同目录下，在同目录下新建“汇总工作簿.xls”,打

开后，按Alt+F11进入代码编辑界面,点击插入-模块，将代码复制粘贴进去，点

击运行。

二、将多个工作簿的所有工作表(sheet)复制到一个工作簿内,代码：

Sub CombineFiles()

Dim path As String

Dim FileName As String

Dim LastCell As Range

Dim Wkb As Workbook

Dim WS As Worksheet

Dim ThisWB As String

Dim MyDir As String

MyDir = & ""

'ChDrive Left(MyDir, 1) 'find all the excel files

'ChDir MyDir

'Match = Dir$("")

ThisWB =

Events = False

Updating = False

path = MyDir

FileName = Dir(path & "*.xls", vbNormal)

Do Until FileName = ""

If FileName <> ThisWB Then

Set Wkb = (FileName:=path & "" & FileName)

For Each WS In eets

Set LastCell = lCells(xlCellTypeLastCell)

If = "" And s

Range("$A$1").Address Then

Else

After:=()

End If

Next WS

False

End If

FileName = Dir()

Loop

Events = True

=

Updating = True

Set Wkb = Nothing

Set LastCell = Nothing

End Sub

三、将多个工作簿的第一张工作表（sheet）复制到一个工作簿内,代码：

Private Sub 合并工作薄()

Dim f_name As String

Dim bok1 As Workbook, bok2 As Workbook

Set bok2 = Nothing

f_name = Dir( & "*.*") '获得该目录下的所有EXCEL文件

Do While f_name <> "" '开始执行循环

If f_name <> Then '如果当前的文件不是代码所在文

件，执行合并操作

Set bok1 = ( & "" & f_name) '打

开被合并的文件

If bok2 Is Nothing Then '合并后的文件是否存在

(1).Copy '如果合并后的文件不存在，则创建一个

Set bok2 = ActiveWorkbook

Else

(1).Copy Before:=(1) '如果合并后的文件

存，在则将被合并文件的第一个工作表复制到合并文件中。

End If

'关闭被合并文件

End If

f_name = Dir() '获取下一个被合并文件名

Loop

End Sub

四、将多个工作簿的所有工作表（sheet）复制到一个工作簿的同一个sheet内,

代码：

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Updating = False

MyPath =

MyName = Dir(MyPath & "" & "*.xls")

AWbName =

Num = 0

Do While MyName <> ""

If MyName <> AWbName Then

Set Wb = (MyPath & "" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To

(G). .Cells(.Range("A65536").End(xlUp).Row + 1, 1)

Next

WbN = WbN & Chr(13) &

False

End With

End If

MyName = Dir

Loop

Range("A1").Select

Updating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) &

WbN, vbInformation, "提示"

End Sub