只能在1个工作簿上运行一个VBA

我正在尝试在多个工作簿上运行Combine。 当我运行下面的代码时，它只运行在一个工作簿上，然后closures，不会继续下一个wb。 任何帮助将是伟大的。

Sub AllFiles() Dim folderPath As String Dim filename As String Dim wb As Workbook folderPath = "C:\Users\USER\Desktop\OCCREPORTS\Files\" 'change to suit If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\" filename = Dir(folderPath & "*.xlsx") Do While filename <> "" Application.ScreenUpdating = False Set wb = Workbooks.Open(folderPath & filename) wb.Activate Call Combine filename = Dir() Loop Application.ScreenUpdating = True End Sub Sub Combine() Dim J As Integer Dim s As Worksheet Dim LastCol As Integer On Error Resume Next Sheets(1).Select Worksheets.Add ' add a sheet in first place Sheets(1).Name = "Combined" For Each s In ActiveWorkbook.Sheets If s.Name <> "Combined" Then Application.Goto Sheets(s.Name).[A1] Selection.CurrentRegion.Select Sheet.UsedRange.Clear LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column Selection.Copy Destination:=Sheets("Combined"). _ Cells(1, LastCol + 1) End If Next ActiveWorkbook.Save End Sub 

Answer 1

根据我在评论中的build议，尝试将文件信息作为parameter passing给Call子项，请参阅下面的内容：

 Sub AllFiles() Dim folderPath As String Dim filename As String Dim wb As Workbook folderPath = "C:\Users\USER\Desktop\OCCREPORTS\Files\" 'change to suit If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\" filename = Dir(folderPath & "*.xlsx") Do While filename <> "" Application.ScreenUpdating = False Call Combine(folderPath & filename) filename = Dir() Loop Application.ScreenUpdating = True End Sub Sub Combine(fileToOpen As String) Dim J As Integer Dim s As Worksheet Dim LastCol As Integer Dim wb As Workbook Set wb = Workbooks.Open(fileToOpen) With wb On Error Resume Next .Sheets(1).Select Worksheets.Add ' add a sheet in first place .Sheets(1).Name = "Combined" For Each s In .Sheets If s.Name <> "Combined" Then Application.Goto .Sheets(s.Name).[A1] Selection.CurrentRegion.Select .Sheet.UsedRange.Clear LastCol = .Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column Selection.Copy Destination:=.Sheets("Combined"). _ Cells(1, LastCol + 1) End If Next .Save .Close End With End Sub