多Excel文件多工作表导入单工作簿VBA代码故障排查求助

我最近在写VBA代码，想通过文件选择器选多个Excel工作簿，把它们的数据合并到单个目标工作簿里。源文件和目标文件都有3个结构完全一致的工作表。现在的问题是，选单个文件时代码能正常运行，但选2个及以上文件时，数据就没法复制到目标工作表里。我是VBA新手，试了好几种方法都没找到问题出在哪，恳请帮忙排查一下！

我之前写的代码： #

Const premiere_ligne_J = 6
Sub import_donnees_J(chemin_tem)
    Application.Calculation = xlCalculationManual
    Dim dataJ As Worksheet
    Set dataJ = ThisWorkbook.Worksheets("Import data Sheet 1")
    Dim Ctr
    Application.DisplayAlerts = False
    For Ctr = 1 To Application.FileDialog(msoFileDialogFilePicker).SelectedItems.Count
        Workbooks.Open (chemin_tem)
        tem = ActiveWorkbook.Name
        Workbooks(tem).Activate
        Application.DisplayAlerts = True
        Set templateJ = Workbooks(tem).Sheets("Import data Sheet 1")
        dernier_client = templateJ.Range("A" & Rows.Count).End(xlUp).Row
        ligne = premiere_ligne_J
        For client = premiere_ligne_J To dernier_client
            'Copying data
            For col = colJ_pdl_data To colJ_rapport_precision_data
                dataJ.Cells(ligne, col) = templateJ.Cells(client, col)
            Next col
            ligne = ligne + 1
suite::
        Next client
        Workbooks(tem).Close SaveChanges:=False
    Next Ctr
    Application.Calculation = xlCalculationAutomatic
End Sub

主程序调用部分：

Call Import1.import_donnees_J(chemin_tem)
Call Import2.import_donnees_V(chemin_tem)
Call Import3.import_donnees_B(chemin_tem)

chemin_tem的定义：

chemin_tem = CStr(Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1))

问题排查与修正 #

我帮你梳理了代码里的几个核心问题，正是这些问题导致批量导入失败：

1. 只处理了第一个选中的文件
   你定义chemin_tem时只取了SelectedItems(1)，也就是第一个文件的路径，循环里每次都打开同一个文件，后面选中的文件根本没被处理。而且循环里还重复调用了Application.FileDialog(msoFileDialogFilePicker)，这会导致每次循环都重新弹出选择框，完全没必要。

2. 不必要的激活操作
   用ActiveWorkbook和Activate操作很容易引发对象引用错误，尤其是批量处理时，应该直接通过对象变量来操作工作簿和工作表，避免依赖“活动状态”。

3. 变量缺失定义
   代码里的colJ_pdl_data、colJ_rapport_precision_data没有看到定义，这会导致复制列的范围出错，甚至代码报错。

修正后的完整代码 #

先修改主程序（负责选择文件并调用导入函数）

Sub Main_Import()
    Dim fileDialog As FileDialog
    Dim selectedFiles As Variant
    Dim i As Integer
    
    ' 创建文件选择器对话框
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fileDialog
        .AllowMultiSelect = True ' 允许多选文件
        .Title = "请选择要导入的Excel文件"
        .Filters.Add "Excel文件", "*.xlsx;*.xls"
        If .Show = -1 Then ' 如果用户选择了文件
            selectedFiles = .SelectedItems
            ' 调用三个工作表的导入函数，传入所有选中的文件路径
            Call Import1.import_donnees_J(selectedFiles)
            Call Import2.import_donnees_V(selectedFiles)
            Call Import3.import_donnees_B(selectedFiles)
        End If
    End With
    Set fileDialog = Nothing
End Sub

然后修改导入函数（以import_donnees_J为例，另外两个函数逻辑一致）

Const premiere_ligne_J = 6
' 注意：请确保colJ_pdl_data和colJ_rapport_precision_data已正确定义，比如：
' Const colJ_pdl_data = 1 ' 对应A列
' Const colJ_rapport_precision_data = 10 ' 对应J列
Sub import_donnees_J(selectedFiles As Variant)
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    Dim dataJ As Worksheet
    Set dataJ = ThisWorkbook.Worksheets("Import data Sheet 1")
    
    Dim srcWorkbook As Workbook
    Dim srcWorksheet As Worksheet
    Dim lastRow As Long
    Dim targetRow As Long
    Dim i As Integer
    
    ' 获取目标工作表的最后一行，避免覆盖已有数据（如果需要追加的话）
    targetRow = dataJ.Range("A" & dataJ.Rows.Count).End(xlUp).Row
    ' 如果目标工作表还没有数据，从premiere_ligne_J开始
    If targetRow < premiere_ligne_J Then targetRow = premiere_ligne_J
    
    ' 遍历所有选中的文件
    For i = LBound(selectedFiles) To UBound(selectedFiles)
        ' 打开源文件
        Set srcWorkbook = Workbooks.Open(selectedFiles(i))
        ' 获取源工作表
        Set srcWorksheet = srcWorkbook.Worksheets("Import data Sheet 1")
        
        ' 获取源工作表的最后一行数据
        lastRow = srcWorksheet.Range("A" & srcWorksheet.Rows.Count).End(xlUp).Row
        
        ' 复制数据（从premiere_ligne_J到lastRow的行，指定列范围）
        If lastRow >= premiere_ligne_J Then
            srcWorksheet.Range(srcWorksheet.Cells(premiere_ligne_J, colJ_pdl_data), _
                               srcWorksheet.Cells(lastRow, colJ_rapport_precision_data)).Copy _
                               dataJ.Cells(targetRow, colJ_pdl_data)
            ' 更新目标行，准备下一个文件的数据
            targetRow = targetRow + (lastRow - premiere_ligne_J + 1)
        End If
        
        ' 关闭源文件，不保存
        srcWorkbook.Close SaveChanges:=False
    Next i
    
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
End Sub

关键修改说明 #

• 传递所有选中的文件路径：主程序把所有选中的文件路径存入数组selectedFiles，然后传给导入函数，这样函数就能遍历每个文件。
• 直接使用对象引用：用srcWorkbook和srcWorksheet变量直接操作源文件，避免Activate和ActiveWorkbook的不可靠性。
• 批量复制数据：用Range.Copy批量复制整段数据，比逐单元格赋值效率高很多。
• 处理目标行的追加：每次导入后更新目标行，确保新数据追加在已有数据的后面，不会覆盖。

另外，记得给colJ_pdl_data和colJ_rapport_precision_data这两个常量赋值，比如对应你需要复制的起始列和结束列的列号（比如A列是1，B列是2，以此类推）。另外两个工作表的导入函数import_donnees_V和import_donnees_B，只需要把对应的常量和工作表名称替换一下就行，逻辑完全一致。

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