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

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

要完成上述效果，如果用手工，有几十上百的表的话 还是挺费劲，不过还好咱们有万能的EXCEL神器-VBA，我用VBA写了一个小工具 ，可以非常快速的完成这种操作123456789101112131415161718192021222324252627282930313233343536373839Private Sub bookMerge()'    MsgBox "欢迎使用合并工作表工具1.0" & Chr(13) & "made by 一无所有 qq80871835" & Chr(13) _'        & "本工具将合并当前目录下所有工作簿的第一个工作表到一个工作簿"'Dim fs, f, f1, fc, sDim wk As Workbook, sht As WorksheetSet fs = CreateObject("Scripting.FileSystemObject")Set f = fs.GetFolder(ThisWorkbook.Path)Set fc = f.FilesSet targetWk = Workbooks.AddActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\合并.xlsx"Set targetSht = ActiveWorkbook.Sheets(1)targetSht.Name = "合并"Application.DisplayAlerts = FalseApplication.ScreenUpdating = FalseFor Each f1 In fc '遍历文件夹文件If f1.Name <> ThisWorkbook.Name And (Right(f1.Name, 3) = "xlsx" Or Right(f1.Name, 3) = "xls") And f1.Name <> "合并.xlsx" ThenSet wk = Workbooks.Open(ThisWorkbook.Path & "\" & f1.Name) '打开工作簿Set sht = wk.ActiveSheetIf ThisWorkbook.ActiveSheet.Range("a1") = 1 Then sht.Name = Left(wk.Name, Len(wk.Name) - 4)sht.Copy After:=Workbooks("合并.xlsx").ActiveSheetwk.CloseEnd IfNexttargetWk.SaveApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueThisWorkbook.Close SaveChanges:=True'MsgBox sEnd SubPublic Sub 合并工作簿()MsgBox "欢迎使用合并工作表工具1.0" & Chr(13) & "made by Excel880.com qq80871835" & Chr(13) _& "本工具将合并当前目录下所有工作簿的第一个工作表到一个新工作簿"Call bookMergeEnd Sub