多文件合并

合并同一文件夹下的所有工作簿

Sub MergeAllWorkbooks()
    Dim folder As String
    Dim fileName As String
    Dim targetRow As Long

    folder = ThisWorkbook.Path & "\Data\"
    fileName = Dir(folder & "*.xlsx")
    targetRow = 1

    Do While fileName <> ""
        With Workbooks.Open(folder & fileName)
            .Sheets(1).UsedRange.Copy _
                ThisWorkbook.Sheets("汇总").Cells(targetRow, 1)
            targetRow = ThisWorkbook.Sheets("汇总").Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Close False
        End With
        fileName = Dir()
    Loop
    MsgBox "合并完成！"
End Sub

合并当前工作簿的所有工作表

Sub MergeAllSheets()
    Dim ws As Worksheet
    Dim target As Worksheet
    Dim lastRow As Long

    Set target = Sheets.Add(After:=Sheets(Sheets.Count))
    target.Name = "汇总"

    For Each ws In Worksheets
        If ws.Name <> "汇总" Then
            lastRow = target.Cells(Rows.Count, 1).End(xlUp).Row
            If lastRow = 1 And target.Cells(1, 1) = "" Then
                ws.UsedRange.Copy target.Range("A1")
            Else
                ws.UsedRange.Copy target.Range("A" & (lastRow + 1))
            End If
        End If
    Next
End Sub