合并当前目录下的所有工作表，免去一个个打开工作表，一张张工作表复印粘贴的烦恼。
要求目录下的工作表的后缀是统一的，如全是xls，或全是xlsx，或全是xlsm。需要在代码中修改。例如合并如下四表
表一
表二
表三
表四
合并
一、新建一个工作表用于合并，命名为‘合并当前目录下的所有表格’，打开工作表，复制其他工作表的表头，另存为后缀为xlsm的工作表。
命名
二、在开发工具中选择VB编辑器。
三、写入以下代码：(注意这句MyName = Dir(Path & "\" & "*.xlsx")，后面xlsx根据当前目录下的后缀手动改写)
Sub 合并当前目录下所有工作表()
'清除当前表格在所有内容
Range("2:1048576").ClearContents
'申明相关变量
Dim Path, MyName, DWBName
Dim Wb As Workbook, WBW As String
Dim G As Long
Dim K As Long
'关闭更新以提高速度
Application.ScreenUpdating = False
'获取当前操作表格的目录
Path = ActiveWorkbook.Path
'获取当前目录下所有表格文件，注意表格听后缀，需要时进行修改
MyName = Dir(Path & "\" & "*.xlsx")
'获取当前活动表
DWBName = ActiveWorkbook.Name
K = 0
Do While MyName <> ""
If MyName <> DWBName Then
Set Wb = Workbooks.Open(Path & "\" & MyName)
K = K 1
With Workbooks(1).ActiveSheet
If K = 1 Then
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Offset(1, 0).Copy .Cells(.Range("A1048576").End(xlUp).Row 1, 1)
Next
Else
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Offset(1, 0).Copy .Cells(.Range("A1048576").End(xlUp).Row 1, 1)
Next
End If
WBW = WBW & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
MsgBox "合并完成"
End Sub
四、点击运行宏或快捷键F5，完成合并。
结果如下：
结果
