VBA批量合并目录下工作簿所有工作表

VBA 代码实现批量合并工作簿

Sub 合并所有工作表()
Dim MyPath As String, FilesInPath As String
Dim MyBook As Workbook
Dim TargetWorkbook As Workbook
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet

' 获取当前目录
MyPath = ActiveWorkbook.Path

' 设置目标工作簿
Set TargetWorkbook = Workbooks.Add

' 遍历目录下所有 Excel 文件
FilesInPath = Dir(MyPath & "" & "*.xlsm")
Do While FilesInPath <> ""
    ' 打开工作簿
    Set MyBook = Workbooks.Open(Filename:=MyPath & "" & FilesInPath)

    ' 遍历工作簿中的所有工作表
    For Each SourceSheet In MyBook.Sheets
        ' 复制工作表到目标工作簿
        SourceSheet.Copy After:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
        ' 重命名工作表（可选）
        TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count).Name = SourceSheet.Name & "_" & MyBook.Name
    Next SourceSheet

    ' 关闭工作簿
    MyBook.Close SaveChanges:=False

    ' 获取下一个文件
    FilesInPath = Dir
Loop

' 保存目标工作簿
TargetWorkbook.SaveAs MyPath & "合并后的工作簿.xlsm"

End Sub

代码说明

• 该代码使用 Dir 函数遍历指定目录下的所有 ".xlsm" 文件。
• 对于每个文件，代码使用 Workbooks.Open 方法打开工作簿。
• 使用嵌套循环遍历每个工作簿中的所有工作表，并将它们复制到目标工作簿中。
• 可以使用 TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count).Name 来自定义工作表名称，避免重复。
• 最后，代码保存目标工作簿。

注意事项

• 请将代码中的文件路径和文件名修改为实际路径和文件名。
• 确保所有要合并的工作簿格式一致，以避免数据错位。