Question

我已下载a macro，效果很好，但我想合并所有工作簿表。这个宏只是第一个工作表：

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

最简单的方法是将每个工作表另存为单独的工作簿。只要工作簿的数量有限，这就需要很少的努力。

另一种解决方案是为其构建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＆lt;。

代替1。

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

（p.s。不应该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

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

2 个答案: