将多个Excel文件导入主Excel文件并包含文件名

宏代码实现 #

打开你的汇总用主Excel文件，按Alt+F11打开VBA编辑器，插入模块后粘贴以下代码：

Sub ImportFilesWithFileName()
    Dim mainWb As Workbook
    Dim sourceWb As Workbook
    Dim mainWs As Worksheet
    Dim sourceWs As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim lastRowMain As Long
    Dim lastRowSource As Long
    
    ' 指定主工作簿和目标工作表，把"Sheet1"改成你的汇总表名称
    Set mainWb = ThisWorkbook
    Set mainWs = mainWb.Sheets("Sheet1")
    
    ' 弹出窗口让你选择要导入的文件所在文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择包含Excel文件的文件夹"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "未选择文件夹，操作终止"
            Exit Sub
        End If
    End With
    
    ' 关闭屏幕刷新，提升导入速度
    Application.ScreenUpdating = False
    
    ' 遍历文件夹中的xlsx文件，如需支持xls格式，改成"*.xls*"
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' 跳过主文件本身，避免重复导入
        If fileName <> mainWb.Name Then
            Set sourceWb = Workbooks.Open(folderPath & fileName)
            ' 默认取每个文件的第一个工作表，如需指定表名，改成sourceWb.Sheets("你的表名")
            Set sourceWs = sourceWb.Sheets(1)
            
            ' 获取主表和源表的最后一行行号
            lastRowMain = mainWs.Cells(mainWs.Rows.Count, "A").End(xlUp).Row
            lastRowSource = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
            
            ' 从源表第2行开始复制（跳过表头），如果源表无表头，改成A1
            If lastRowSource > 1 Then
                sourceWs.Range("A2:" & sourceWs.Cells(lastRowSource, sourceWs.Columns.Count).Address).Copy _
                    mainWs.Cells(lastRowMain + 1, "A")
                
                ' 在导入数据的最右侧空白列添加对应文件名
                mainWs.Range(mainWs.Cells(lastRowMain + 1, mainWs.Columns.Count).End(xlToLeft).Offset(0, 1), _
                    mainWs.Cells(lastRowMain + lastRowSource - 1, mainWs.Columns.Count).End(xlToLeft).Offset(0, 1)).Value = fileName
            End If
            
            ' 关闭源文件，不保存任何修改
            sourceWb.Close SaveChanges:=False
        End If
        ' 取下一个文件
        fileName = Dir
    Loop
    
    ' 恢复屏幕刷新
    Application.ScreenUpdating = True
    MsgBox "所有文件导入完成！"
End Sub

关键调整说明 #

• 如果源文件没有表头，把代码中sourceWs.Range("A2:" & ...)改成sourceWs.Range("A1:" & ...)，同时删除If lastRowSource > 1 Then和对应的End If
• 如果要把文件名固定放在某一列（比如B列），将添加文件名的代码里的mainWs.Cells(lastRowMain + 1, mainWs.Columns.Count).End(xlToLeft).Offset(0, 1)改成mainWs.Cells(lastRowMain + 1, "B")

操作步骤 #

1. 打开汇总用的主Excel文件
2. 按Alt+F11打开VBA编辑器
3. 右键点击左侧工程窗口，选择「插入」→「模块」
4. 粘贴上述代码，按需调整参数
5. 按F5运行宏，或回到Excel界面，通过「开发工具」→「宏」选择ImportFilesWithFileName执行

注意事项 #

• 确保所有源文件的列结构一致，避免数据错位
• 运行前建议备份主文件和源文件，防止意外错误

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