在一百个工作簿中应用macros，然后将结果复制到主Excel文件中

我重写了它…这是一个更好的，但它不完全是我想要的…这是一些示例数据与成品的例子。

示例数据： https ： //drive.google.com/folderview？id = 0B0m5F-NRHk_kTFRyb0JxYmo5Ykk&usp=drive_web

Option Explicit Sub MergeAllSheetsInAllWorkbooks() Dim fPATH As String, fNAME As String, LastCol As Long Dim wb As Workbook, ws As Worksheet, Combined As Worksheet Application.ScreenUpdating = False 'speed up macro execution Application.DisplayAlerts = False 'take default answer for all error alerts fPATH = ThisWorkbook.Path & "\Files\" 'path to data files, possibly use ActiveWorkbook Sheets.Add 'create the new sheet ActiveSheet.Move 'move to new workbook Set Combined = ActiveSheet 'set anchor to new sheet Combined.Name = "Combined" 'set the name LastCol = 1 'starting column for new output fNAME = Dir(fPATH & "*.xls") 'get first filename Do While Len(fNAME) > 0 'loop one file at a time Set wb = Workbooks.Open(fPATH & fNAME) 'open the found file For Each ws In wb.Worksheets 'cycle through all the sheets in the wb ws.Range("A1").CurrentRegion.Copy Combined.Cells(1, LastCol) 'copy to COMBINED sheet LastCol = Combined.Cells(1, Columns.Count).End(xlToLeft).Column + 1 'set next target column Next ws wb.Close False 'close the found file fNAME = Dir 'get the next filename Loop 'save the results Combined.Parent.SaveAs "C:\Users\username\Desktop\OCCREPORTS\Target.xlsx", 51 Application.ScreenUpdating = True 'update screen all at once End Sub 

Answer 1

尝试重新sortingDoWork子的底部，因为End If应该先来，然后Next ，然后最后End With

而不是这个：

  End With End If Next 

做：

  End If Next End With