Excel VBA多工作簿选择、打开及数据复制问题求助

原代码存在以下关键问题导致运行中断：

• 未正确初始化主工作簿对象wb，仅定义类型但未赋值，直接调用wb.Activate会触发「对象变量或With块变量未设置」错误
• 硬编码处理两个选中文件，无法适配用户选择的任意数量文件
• 过度依赖Select/Activate操作，这是VBA运行时错误的常见诱因，应直接通过对象引用操作数据
• 固定粘贴到D1位置，会覆盖主工作表中已有的数据

以下是优化后的实现，解决了上述问题并提升了代码稳定性：

Option Explicit

Sub ImportMultipleWorkbooks()
    Dim wbMain As Workbook
    Dim wsMain As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim fileDialog As FileDialog
    Dim selectedItem As Variant
    Dim lastRowMain As Long
    Dim lastColSource As Long
    Dim lastRowSource As Long
    
    ' 绑定主工作簿和目标工作表（当前运行代码的工作簿）
    Set wbMain = ThisWorkbook
    Set wsMain = wbMain.Worksheets("Data")
    
    ' 创建文件选择对话框
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fileDialog
        .AllowMultiSelect = True
        .Filters.Clear
        .Filters.Add "Excel文件", "*.xls*"
        
        If .Show = True Then
            ' 禁用屏幕更新，提升运行效率并避免界面闪烁
            Application.ScreenUpdating = False
            
            ' 循环处理每个选中的文件
            For Each selectedItem In .SelectedItems
                ' 打开源工作簿
                Set wbSource = Workbooks.Open(selectedItem)
                ' 绑定源数据所在的工作表（假设源数据在"Data"表，可根据实际修改）
                Set wsSource = wbSource.Worksheets("Data")
                
                ' 计算源数据的有效范围（从D1开始的连续数据）
                lastColSource = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
                lastRowSource = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
                
                ' 计算主工作表的粘贴起始行，避免覆盖已有数据
                lastRowMain = wsMain.Cells(wsMain.Rows.Count, "D").End(xlUp).Row
                ' 处理主表为空的情况，从D1开始粘贴
                If lastRowMain < 1 Then lastRowMain = 1 Else lastRowMain = lastRowMain + 1
                
                ' 直接复制源数据到主表，全程无需激活/选择操作
                wsSource.Range(wsSource.Cells(1, "D"), wsSource.Cells(lastRowSource, lastColSource)).Copy _
                    Destination:=wsMain.Cells(lastRowMain, "D")
                
                ' 关闭源工作簿，不保存更改
                wbSource.Close SaveChanges:=False
            Next selectedItem
            
            ' 恢复屏幕更新
            Application.ScreenUpdating = True
            MsgBox "数据导入完成！"
        End If
    End With
End Sub

• 直接绑定主工作簿和工作表，彻底避免Activate/Select操作引发的错误
• 循环处理所有选中文件，适配任意数量的文件选择
• 自动计算源数据范围和主表粘贴位置，确保新数据追加到已有数据下方
• 禁用屏幕更新，提升运行速度并优化用户体验
• 处理完成后自动关闭源工作簿，无需手动操作

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