合并所有工作簿与文件夹中的所有工作表

我已经下载了一个运行良好的macros ，但是我想合并所有的工作簿表单。 这个macros只是第一个工作表：

Sub MergeAllWorkbooks() Dim SummarySheet As Worksheet Dim FolderPath As String Dim NRow As Long Dim FileName As String Dim WorkBk As Workbook Dim SourceRange As Range Dim DestRange As Range Application.DisplayAlerts = False Application.ScreenUpdating = False ' Create a new workbook and set a variable to the first sheet. 'Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1) Set SummarySheet = ThisWorkbook.Sheets.Add SummarySheet.Name = "ALL" 'Clear all old data SummarySheet.Cells.Delete ' Modify this folder path to point to the files you want to use. FolderPath = "C:\excel\" ' NRow keeps track of where to insert new rows in the destination workbook. NRow = 1 ' Call Dir the first time, pointing it to all Excel files in the folder path. FileName = Dir(FolderPath & "*.xl*") ' Loop until Dir returns an empty string. Do While FileName <> "" ' Open a workbook in the folder Set WorkBk = Workbooks.Open(FolderPath & FileName) ' Set the cell in column A to be the file name. SummarySheet.Range("A" & NRow).Value = FileName ' Set the source range to be A9 through C9. ' Modify this range for your workbooks. ' It can span multiple rows. Dim LastRow As Long LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _ After:=WorkBk.Worksheets(1).Cells.Range("A1"), _ SearchDirection:=xlPrevious, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows).Row Set SourceRange = WorkBk.Worksheets(1).Range("A1:AA" & LastRow1) ' Set the destination range to start at column B and ' be the same size as the source range. Set DestRange = SummarySheet.Range("B" & NRow) Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count) ' Copy over the values from the source to the destination. DestRange.Value = SourceRange.Value SourceRange.Copy DestRange.PasteSpecial (xlPasteFormats) Application.CutCopyMode = False ' Increase NRow so that we know where to copy data next. NRow = NRow + DestRange.Rows.Count ' Close the source workbook without saving changes. WorkBk.Close savechanges:=False ' Use Dir to get the next file name. FileName = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

在我的.xl *文件中，可变数量的表（有时是一个，有时是六个）。

你可以帮我循环打开工作簿中的每一张？

Answer 1

那么最简单的方法是将每个工作表保存为一个单独的工作簿。 只要工作簿的数量有限，这将需要很less的努力。

另一个解决scheme是build立一个FOR循环。 那会在以后开始：

 ' Open a workbook in the folder Set WorkBk = Workbooks.Open(FolderPath & FileName) 

而且会是这样的：

 Dim L As Long L = ThisWorkbook.Worksheets.Count For Worksheets 1 to L 

然后插入一个NEXT

 ' Increase NRow so that we know where to copy data next. NRow = NRow + DestRange.Rows.Count 

我不是这方面的专家，但是在过去的几周里我一直在做类似的事情，所以让我知道是否有帮助。

Answer 2

我会说user148116是非常接近。 但从那里的一些变化。

像这样设置循环

 Dim L As Long For L = 1 To WorkBk.Worksheets.Count 

也可以用L's取代1

 Set SourceRange = WorkBk.Worksheets(L).Range("A1:AA" & LastRow1) 

（PS不应该LastRow1是LastRow？）

最终结果（对于内部循环）如下所示：

 ' Loop until Dir returns an empty string. Do While Filename <> "" ' Open a workbook in the folder Set WorkBk = Workbooks.Open(FolderPath & Filename) Dim L As Long For L = 1 To WorkBk.Worksheets.Count ' Set the cell in column A to be the file name. SummarySheet.Range("A" & NRow).Value = Filename ' Set the source range to be A9 through C9. ' Modify this range for your workbooks. ' It can span multiple rows. Dim LastRow As Long LastRow = WorkBk.Worksheets(L).Cells.Find(What:="*", _ After:=WorkBk.Worksheets(L).Cells.Range("A1"), _ SearchDirection:=xlPrevious, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows).Row Set SourceRange = WorkBk.Worksheets(L).Range("A1:AA" & LastRow1) ' Set the destination range to start at column B and ' be the same size as the source range. Set DestRange = SummarySheet.Range("B" & NRow) Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count) ' Copy over the values from the source to the destination. DestRange.Value = SourceRange.Value SourceRange.Copy DestRange.PasteSpecial (xlPasteFormats) Application.CutCopyMode = False ' Increase NRow so that we know where to copy data next. NRow = NRow + DestRange.Rows.Count Next L ' Close the source workbook without saving changes. WorkBk.Close savechanges:=False ' Use Dir to get the next file name. Filename = Dir() Loop