将多个EXCEL文件合并(组合)成多个SHEET的单文件 VBA方法 多表组合 图文

请问如何把同一文件夹的所有工作簿合并到一个文件里,每个工作簿成为一个工作表

前面讲过了一个文件里【多个sheet拆分成为多个单独文件】的方法，这里再讲一讲逆向操作，就是我们要把多个只有一张sheet的文件，合并成一个文件里多个sheet的样子，如下图所示

要完成上述效果，如果用手工，有几十上百的表的话 还是挺费劲，不过还好咱们有万能的Excel神器-VBA，我用VBA写了一个小工具 ，可以非常快速的完成这种操作

VBA教程请点击 https://item.taobao.com/item.htm?id=597656284129

Private Sub bookMerge(path)
'  "本工具将组合当前目录下所有工作簿的第一个表到一个新文件中"
'*****http://excel880.com/
    Dim fs, f, f1, fc, s
    Dim wk As Workbook, sht As Worksheet
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(path)
    Set fc = f.Files
    Set targetWk = Workbooks.Add
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.path & "\组合.xlsx"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    For Each f1 In fc '遍历文件夹文件
        If f1.Name <> ThisWorkbook.Name And f1.Name Like "*.xls*" And f1.Name <> "组合.xlsx" Then
            Set wk = Workbooks.Open(path & "\" & f1.Name) '打开工作簿
            Set sht = wk.ActiveSheet
                If ThisWorkbook.Sheets("x").Range("B2") = 1 Then
                    sht.Name = Mid(wk.Name, 1, InStrRev(wk.Name, ".") - 1)
                End If '改sheet名同文件名
                sht.Copy After:=Workbooks("组合.xlsx").ActiveSheet
            wk.Close
        End If
    Next
    targetWk.Save
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    'ThisWorkbook.Close SaveChanges:=True
    'MsgBox s
End Sub

Public Sub 多表合一()
    MsgBox "欢迎使用多表合一工具1.0" & Chr(13) & "made by Excel880 QQ80871835" & Chr(13) _
      & "本工具将组合当前目录下所有工作簿的第一个表到一个新文件中"
    bookMerge ThisWorkbook.Sheets("x").Range("B1")
End Sub