多个excel文件sheet页进行合并

'以下代码是将某个文件夹下的多个excel文件中的某个Sheet进行合并到一个文件的某个Sheet页中

'以下是多文件单sheet页操作   注意此语句多一个标题行
Sub MergeAllSheetsWithHeaders()
    Dim path As String, file As String
    Dim wb As Workbook
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long, nextRow As Long
    Dim isFirstFile As Boolean
    ' 获取当前工作簿所在路径
    path = ThisWorkbook.path & "\"    '如果目标和源文件不在一个目录，可使用绝对路径
    ' 获取第一个符合条件的文件
    file = Dir(path & "*.xlsx")
    MsgBox path
' 设置目标工作表，这里假设目标工作表为当前工作簿的第一个工作表
Set targetSheet = ThisWorkbook.Sheets(1)
' 清空目标工作表的内容
targetSheet.Cells.ClearContents

isFirstFile = True
Application.ScreenUpdating = False

Do While file <> ""
    ' 避免打开当前工作簿
    MsgBox file   ' 显示操作的是哪个文件
    
    If file <> ThisWorkbook.Name Then
        ' 打开文件
        Set wb = Workbooks.Open(path & file)
        ' 设置源工作表，这里假设要合并的工作表名为 "Sheet1"
        Set sourceSheet = wb.Sheets("Sheet1")
        ' 获取源工作表的最后一行
        lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
        ' 获取目标工作表的下一个空行
        nextRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row + 1
        
        ' 如果是第一个文件，复制标题行
        If isFirstFile Then
            sourceSheet.Range("A1:" & sourceSheet.Cells(1, sourceSheet.Columns.Count).Address).Copy _
                targetSheet.Cells(1, 1)
            isFirstFile = False
        End If
        
        ' 复制源工作表的数据到目标工作表
        sourceSheet.Range("A1:" & sourceSheet.Cells(lastRow, sourceSheet.Columns.Count).Address).Copy _
            targetSheet.Cells(nextRow, 1)
        ' 关闭打开的文件，不保存更改
        wb.Close SaveChanges:=False
    End If
    ' 获取下一个符合条件的文件
    file = Dir
Loop

Application.ScreenUpdating = True
MsgBox "合并完成！"
End Sub





'以下是多文件多sheet页操作
' 环境：当前文档有N个excel文件，新建一个空EXCEL文件，创建VBA，放入代码，将所有EXCEL文件进行合并到此文件中，以相同sheet为名

Sub MergeMultipleSheetsFromMultipleFiles()
    Dim path As String, file As String
    Dim sourceWB As Workbook, targetWB As Workbook
    Dim sourceSheet As Worksheet
    Dim isFirstFile As Boolean
    Dim targetSheetExists As Boolean
    Dim i As Integer
    ' 获取当前工作簿所在路径
path = ThisWorkbook.path & "\"
' 获取第一个符合条件的文件
file = Dir(path & "*.xlsx")

' 设置目标工作簿为当前工作簿
Set targetWB = ThisWorkbook

isFirstFile = True
Application.ScreenUpdating = False

Do While file <> ""
    ' 避免打开当前工作簿
    If file <> targetWB.Name Then
        ' 打开源文件
        Set sourceWB = Workbooks.Open(path & file)
        
        ' 遍历源文件中的每个工作表
        For Each sourceSheet In sourceWB.Sheets
            targetSheetExists = False
            ' 检查目标工作簿中是否已经存在同名的工作表
            For i = 1 To targetWB.Sheets.Count
                If targetWB.Sheets(i).Name = sourceSheet.Name Then
                    targetSheetExists = True
                    Exit For
                End If
            Next i
            
            ' 如果目标工作簿中不存在同名的工作表，则复制该工作表
            If Not targetSheetExists Then
                sourceSheet.Copy After:=targetWB.Sheets(targetWB.Sheets.Count)
            Else
                ' 如果目标工作簿中已经存在同名的工作表，则将源工作表的数据追加到目标工作表中
                Dim lastRowSource As Long, lastColSource As Long
                Dim lastRowTarget As Long
                lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row
                lastColSource = sourceSheet.Cells(1, sourceSheet.Columns.Count).End(xlToLeft).Column
                lastRowTarget = targetWB.Sheets(sourceSheet.Name).Cells(targetWB.Sheets(sourceSheet.Name).Rows.Count, 1).End(xlUp).Row + 1
                If lastRowTarget = 2 Then lastRowTarget = 1 ' 如果目标工作表为空，从第一行开始粘贴
                sourceSheet.Range("A1:" & sourceSheet.Cells(lastRowSource, lastColSource).Address).Copy _
                    targetWB.Sheets(sourceSheet.Name).Cells(lastRowTarget, 1)
            End If
        Next sourceSheet
        
        ' 关闭源文件，不保存更改
        sourceWB.Close SaveChanges:=False
    End If
    ' 获取下一个符合条件的文件
    file = Dir
Loop

Application.ScreenUpdating = True
MsgBox "合并完成！"
End Sub