Excel VBA多工作簿数据合并下标越界报错修复及代码优化

• 核心错误来自循环逻辑问题：当前使用的Do...Loop Until FileName = ""结构会先执行循环体内代码，再判断终止条件，当最后一次Dir返回空串时，仍然会执行Workbooks.Open(Folder & "\" & FileName)打开无效路径，得到的currentWB对象不符合预期，访问不存在的Weekly Totals工作表时就会抛出下标越界。
• 附加错误：AddWorkbook过程中变量名不一致，声明的是TotalsWorkbook，后续调用写的是outWorkbook，运行时会触发异常。

' 全局变量存储汇总工作簿对象，避免重复打开
Dim TotalsBook As Workbook
Dim wsDest As Worksheet

' 主入口，直接运行这个即可完成全部汇总
Sub BatchExcelSummary()
    Dim Folder As String, FileName As String
    Dim currentWB As Workbook
    
    ' 配置参数：修改为你的实际路径
    Folder = "C:\你的目标文件夹路径"
    Const DEST_SAVE_PATH As String = "C:\汇总结果存储路径\汇总表.xlsx"
    
    ' 先创建汇总工作簿
    Call InitTotalsWorkbook(DEST_SAVE_PATH)
    
    ' 遍历所有xlsx文件，修改循环逻辑先判断文件名是否为空再执行
    FileName = Dir(Folder & "\*.xlsx")
    Do While FileName <> ""
        ' 跳过汇总文件本身，避免重复读取
        If Folder & "\" & FileName <> DEST_SAVE_PATH Then
            Set currentWB = Workbooks.Open(Folder & "\" & FileName, ReadOnly:=True)
            Call CopyDataToTotalsWorkbook(currentWB)
            ' 关闭源工作簿不保存
            currentWB.Close SaveChanges:=False
        End If
        FileName = Dir
    Loop
    
    ' 收尾：保存并提示完成
    TotalsBook.Save
    MsgBox "汇总完成，共汇总到第" & wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row & "行", vbInformation
    ' 可取消下面注释直接打开汇总结果
    ' TotalsBook.Activate
End Sub

' 初始化汇总工作簿
Sub InitTotalsWorkbook(savePath As String)
    Set TotalsBook = Workbooks.Add
    Set wsDest = TotalsBook.Sheets("Sheet1")
    wsDest.Name = "Totals"
    ' 可取消注释添加表头，和源表表头字段对应即可
    ' wsDest.Range("A1:M1") = Array("表头1","表头2",...,"表头13")
    TotalsBook.SaveAs Filename:=savePath
End Sub

' 复制数据逻辑
Sub CopyDataToTotalsWorkbook(argWB As Workbook)
    Dim lDestLastRow As Long
    Dim sourceRng As Range
    
    ' 错误捕获：源表没有指定工作表时自动跳过，不会中断汇总
    On Error Resume Next
    Set sourceRng = argWB.Worksheets("Weekly Totals").Range("A2:M6")
    On Error GoTo 0
    
    If Not sourceRng Is Nothing Then
        ' 直接赋值替代剪贴板复制粘贴，效率更高无屏幕闪烁
        lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
        wsDest.Range("A" & lDestLastRow).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count).Value = sourceRng.Value
    End If
End Sub

• 修复循环逻辑：改为Do While FileName <> ""先判断后执行，避免打开无效文件触发报错
• 统一变量调用：修正原代码变量名不一致的问题，用全局变量存储汇总工作簿对象，避免每次复制都重复打开汇总文件，大幅提升运行效率
• 跳过汇总文件本身：避免遍历到刚生成的汇总文件重复读取
• 只读打开源文件：降低文件占用冲突概率，运行速度更快
• 直接赋值替代剪贴板操作：取消剪贴板读写，不会触发屏幕闪烁，复制速度提升明显
• 增加异常捕获：源文件不存在Weekly Totals工作表时自动跳过，不会中断整体汇总流程
• 自动关闭源文件：避免大量工作簿同时打开占用系统内存
• 补充完成提示：明确告知汇总完成状态和最终数据行数

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