请求编写VBA代码实现多工作簿指定数据批量合并至主工作表

以下是针对你的需求优化后的VBA代码，专门处理指定文件夹下所有工作簿中appendix B工作表的C6:F列数据，批量追加到主工作簿的A-D列：

Sub BatchCopyAppendixB()
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行效率
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim wsSource As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    
    ' 配置参数，请根据实际情况修改
    Const strPath As String = "C:\Users\xbv\Desktop\group1\" ' 目标文件夹路径
    Const destSheetName As String = "Master1" ' 主工作簿接收数据的工作表名
    
    Set wkbDest = ThisWorkbook ' 当前运行代码的工作簿作为主工作簿
    
    ' 遍历文件夹下所有Excel文件
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        ' 错误捕获：避免因无目标工作表导致程序崩溃
        On Error Resume Next
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        Set wsSource = wkbSource.Sheets("appendix B") ' 注意与实际工作表名大小写一致
        On Error GoTo 0
        
        ' 确认找到目标工作表后执行复制
        If Not wsSource Is Nothing Then
            ' 获取源数据最后一行（C列非空行的最后一行）
            lastRowSource = wsSource.Range("C" & wsSource.Rows.Count).End(xlUp).Row
            
            ' 仅当存在有效数据（最后行≥6）时复制
            If lastRowSource >= 6 Then
                ' 获取主工作簿目标列的最后一行（A列非空行的下一行）
                lastRowDest = wkbDest.Sheets(destSheetName).Range("A" & wkbDest.Sheets(destSheetName).Rows.Count).End(xlUp).Row + 1
                
                ' 复制C6:F列数据到主工作簿A列起始位置
                wsSource.Range("C6:F" & lastRowSource).Copy _
                    Destination:=wkbDest.Sheets(destSheetName).Range("A" & lastRowDest)
            End If
        End If
        
        ' 关闭源工作簿，不保存修改
        If Not wkbSource Is Nothing Then
            wkbSource.Close savechanges:=False
            Set wkbSource = Nothing
            Set wsSource = Nothing
        End If
        
        strExtension = Dir ' 获取下一个文件
    Loop
    
    Application.ScreenUpdating = True ' 恢复屏幕刷新
    MsgBox "批量复制完成！", vbInformation ' 提示操作完成
End Sub

关键修改与说明 #

• 参数配置：修改strPath为你的实际文件夹路径，destSheetName为你主工作簿中接收数据的工作表名称
• 工作表匹配：确保"appendix B"与源工作簿中的工作表名完全一致（包括大小写），否则会跳过该文件
• 修正原代码bug：原代码中Range对象未指定所属工作表，会导致引用错误，现明确关联到wsSource工作表
• 错误防护：加入错误捕获逻辑，遇到没有appendix B工作表的文件时，程序会继续处理下一个文件，不会中断
• 空数据跳过：仅当源数据最后一行≥6时才执行复制，避免复制空行
• 效率优化：关闭屏幕刷新减少界面闪烁，提升运行速度

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