如何将同文件夹内同布局Excel文件合并至活动工作表？附VBA代码

你可以用下面的VBA代码实现批量合并操作，逻辑是遍历指定文件夹内的所有Excel文件，将每个文件的数据（跳过重复表头）追加到当前活动工作表的末尾：

Option Explicit

Sub MergeExcelFiles()
    Dim sourceFolderPath As String
    Dim currentSheet As Worksheet
    Dim sourceWorkbook As Workbook
    Dim sourceSheet As Worksheet
    Dim lastRowTarget As Long
    Dim lastRowSource As Long
    Dim fileName As String
    
    ' 指定要读取的文件夹路径
    sourceFolderPath = "C:\IKDISKET\"
    ' 指向当前活动工作表
    Set currentSheet = ActiveSheet
    
    ' 获取文件夹中第一个Excel文件
    fileName = Dir(sourceFolderPath & "*.xls*")
    
    Do While fileName <> ""
        ' 跳过当前活动工作表所在的文件（避免循环读取自身）
        If sourceFolderPath & fileName <> ThisWorkbook.FullName Then
            ' 打开源文件（后台静默打开，不显示界面）
            Set sourceWorkbook = Workbooks.Open(sourceFolderPath & fileName, ReadOnly:=True)
            ' 取第一个工作表（如果你的数据在其他工作表，修改这里的索引或名称）
            Set sourceSheet = sourceWorkbook.Sheets(1)
            
            ' 获取目标表的最后一行
            lastRowTarget = currentSheet.Cells(currentSheet.Rows.Count, "A").End(xlUp).Row
            ' 获取源表的最后一行
            lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
            
            ' 复制源表数据：从第2行开始（跳过表头），到最后一行，所有列
            ' 如果源文件没有表头，把2改成1
            sourceSheet.Range("A2:" & sourceSheet.Cells(lastRowSource, sourceSheet.Columns.Count).Address).Copy _
                Destination:=currentSheet.Cells(lastRowTarget + 1, "A")
            
            ' 关闭源文件，不保存修改
            sourceWorkbook.Close SaveChanges:=False
        End If
        
        ' 获取下一个Excel文件
        fileName = Dir()
    Loop
    
    MsgBox "合并完成！"
End Sub

注意事项： #

• 运行代码前，确保当前活动工作表已经有正确的表头（如果每个源文件都带表头），代码会自动跳过源文件的表头行；
• 如果源文件没有表头，把代码里的A2改成A1；
• 确保C:\IKDISKET\文件夹里只有需要合并的Excel文件，避免混入其他格式文件；
• 启用宏功能才能运行这段代码，若提示宏被禁用，需在Excel选项中启用宏。

内容的提问来源于stack exchange，提问作者sc_psp