Excel VBA如何复制以Total结尾的第二个动态表格并修复运行时错误

问题根源 #

当前代码的查找逻辑顺序错误：两次使用SearchDirection:=xlPrevious反向查找，最终获取的startRow实际是下方第二个Total的行号，lastRow反而可能是上方第一个Total的行号，构造的区域行号顺序颠倒，因此触发1004错误。

修复后的代码 #

' 复制绿色背景表格范围
Sub addSetC()
    Dim lastL As Long
    Dim rng As Range
    Dim firstTotalRow As Long
    Dim startRow As Long
    Dim lastRow As Long
    Dim sourceSht As Worksheet
    
    ' 绑定当前操作的源表，避免后续激活操作影响范围判断
    Set sourceSht = ActiveSheet
    lastL = sourceSht.Range("L" & Rows.Count).End(xlUp).Row
    
    With sourceSht.Range("L2:L" & lastL)
        ' 正向查找第一个Total，为蓝色背景表的结束行
        Set rng = .Find(What:="Total", _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        ' 未找到Total直接退出，避免报错
        If rng Is Nothing Then Exit Sub
        firstTotalRow = rng.Row
        ' 第二个绿色表格从第一个Total的下一行开始
        startRow = firstTotalRow + 1
        
        ' 从第一个Total之后开始，正向查找第二个Total，为绿色表的结束行
        Set rng = .Find(What:="Total", _
                        After:=.Cells(firstTotalRow - 1), ' .Cells索引相对于L2起始的范围，因此行号减1
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If rng Is Nothing Then Exit Sub
        lastRow = rng.Row
    End With
    
    ' 复制目标范围
    sourceSht.Range("L" & startRow & ":Q" & lastRow).Copy
    ' 粘贴到DATA表末尾
    With Sheets("DATA")
        .Cells(.Range("A" & .Rows.Count).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues
    End With
    Application.CutCopyMode = False
End Sub

核心修改点 #

1. 调整查找顺序：先正向查找第一个Total行，将其+1作为第二个表格的起始行，再从起始行之后查找第二个Total作为结束行，保证行号顺序正确
2. 所有行号变量改为Long类型，避免表格超过32767行时Integer类型溢出报错
3. 提前绑定源工作表，避免中间操作切换激活表导致范围判断错误
4. 增加找不到Total时的提前退出逻辑，避免后续操作异常

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