VBA合并多工作簿异名工作表报运行时错误9下标越界如何解决

• 待合并文件共42个Excel工作簿，每个工作簿仅包含1个工作表，所有工作表名称均不相同
• 需求：遍历所有工作簿，将各工作表表头行之后的数据行，统一合并汇总到当前运行宏的工作簿内名为All_TripSum的主工作表，代码不硬编码源工作表名称
• 现有VBA代码执行到数据拷贝行时，触发运行时错误'9':下标越界，原代码如下：

Sub CopytoOneSheet()
Application.ScreenUpdating = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Const strPath As String = "C:\Users\me\OneDrive - Company\New folder\" 
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
            LastRow = .ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .ActiveSheet.Range("A2:S" & LastRow).Copy wkbDest.Sheets("All_TripSum").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) '**Getting run-time error '9': Subscript out of range here**
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub 

1. 核心诱因：Dir("*.xls*")会遍历目标路径下所有匹配格式的Excel文件，如果你存放宏的目标工作簿本身就放在该路径下，代码会把它也当成待合并文件打开，执行.Close savechanges:=False时会直接关闭存放All_TripSum表的目标工作簿，后续再访问wkbDest.Sheets("All_TripSum")就会因对象不存在触发下标越界。
2. 隐性风险：用ActiveSheet获取源数据表依赖工作表激活状态，稳定性差；Rows.Count未指定所属工作表时，会默认取当前激活工作表的最大行号，在.xls（最大行65536）和.xlsx/.xlsm（最大行1048576）格式文件混存的场景下会出现行号引用错误。
3. 边界缺失：未判断源表是否存在有效数据、目标表是否真实存在，遇到空文件、表名拼写错误时会直接报错。

Sub CopytoOneSheet()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Dim wsDest As Worksheet
    Dim wsSource As Worksheet
    Dim LastRowSource As Long
    Dim LastRowDest As Long
    Const strPath As String = "C:\Users\me\OneDrive - Company\New folder\"
    
    Set wkbDest = ThisWorkbook
    ' 提前校验目标汇总表是否存在
    On Error Resume Next
    Set wsDest = wkbDest.Sheets("All_TripSum")
    On Error GoTo 0
    If wsDest Is Nothing Then
        MsgBox "当前工作簿不存在名为All_TripSum的汇总工作表，请先创建后再运行代码"
        GoTo ErrorExit
    End If
    
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        ' 跳过当前宏所在的目标工作簿，避免误关自身
        If strExtension <> wkbDest.Name Then
            ' 只读方式打开源文件，避免锁文件
            Set wkbSource = Workbooks.Open(Filename:=strPath & strExtension, ReadOnly:=True)
            ' 每个源文件仅1个工作表，直接取第一个表，不依赖激活状态，适配任意表名
            Set wsSource = wkbSource.Sheets(1)
            With wsSource
                ' 判断源表是否存在有效数据
                If Not .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious) Is Nothing Then
                    LastRowSource = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                    ' 仅当存在表头后的数据行时才执行拷贝
                    If LastRowSource >= 2 Then
                        ' 用目标表的行上限计算粘贴起始位置，避免跨版本行号错误
                        LastRowDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
                        .Range("A2:S" & LastRowSource).Copy wsDest.Range("A" & LastRowDest)
                    End If
                End If
            End With
            wkbSource.Close savechanges:=False
        End If
        strExtension = Dir
    Loop
    MsgBox "所有数据合并完成！"

ErrorExit:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

• 遍历文件时自动跳过当前运行宏的目标工作簿，从根源解决误关闭汇总表导致的下标越界问题
• 源表统一用Sheets(1)获取，完全不依赖工作表名称、激活状态，适配所有源表名不统一的场景
• 所有单元格、行号引用都显式绑定所属工作表，解决不同Excel版本格式混存时的行号引用错误
• 新增目标表存在校验、源表空数据判断，覆盖边界异常场景，代码运行稳定性更高
• 采用只读方式打开源文件，避免合并过程中产生文件锁、意外触发源文件保存提示

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