VBA遍历31个工作表C列匹配Power On整行复制到Sheet33报溢出错误

问题排查 #

溢出报错的核心原因是你用了Integer类型声明行号变量：

• VBA中Integer类型最大只能存储到32767，只要你的单表行数超过这个数值，或者累计要粘贴到Sheet33的行数超过32767，就会触发溢出错误。

另外你代码里还有几个逻辑错误导致遍历功能失效：

• 遍历工作表的循环里，你每次都把ws1设为ActiveSheet，而不是按序号取第I个工作表，相当于始终在操作当前激活的工作表，根本没遍历前31个表
• 循环体里放了Exit Sub，第一次遍历完第一个工作表就直接退出程序了，后面30个表完全不会执行
• 操作单元格时没有指定所属工作表，Range默认调用当前激活表的单元格，切换工作表后很容易取错值
• 大量使用Select操作不仅效率低，还容易触发意料外的激活表切换问题

修正后的代码 #

Sub test()
    ' 行号变量统一用Long，避免溢出，Long最大可到20亿以上，完全满足Excel行数需求
    Dim LSearchRow As Long
    Dim LCopyToRow As Long
    Dim ws1 As Worksheet
    Dim I As Integer
    Dim targetWs As Worksheet
    
    ' 提前定义目标表，避免反复调用 Sheets("Sheet33")
    Set targetWs = ThisWorkbook.Sheets("Sheet33")
    LCopyToRow = 1

    For I = 1 To 31
        ' 按序号取对应工作表，不是取ActiveSheet
        Set ws1 = ThisWorkbook.Sheets(I)
        LSearchRow = 1
        
        ' 所有Range都指定所属工作表ws1，避免取错值
        While Len(ws1.Range("A" & CStr(LSearchRow)).Value) > 0
            If ws1.Range("C" & CStr(LSearchRow)).Value = "Power On" Then
                ' 不用Select，直接复制粘贴，效率更高也不容易出错
                ws1.Rows(LSearchRow).Copy targetWs.Rows(LCopyToRow)
                LCopyToRow = LCopyToRow + 1
            End If
            LSearchRow = LSearchRow + 1
        Wend
    Next I
    ' 清空剪贴板
    Application.CutCopyMode = False
End Sub

优化说明 #

• 所有行号相关变量全部替换为Long类型，彻底解决溢出问题
• 修正了工作表遍历逻辑，按循环序号取对应工作表，确保遍历前31个表
• 删除了错误放置的Exit Sub语句，保证循环可以全部执行完成
• 所有单元格、行操作都显式指定所属工作表，避免取值错误
• 去掉了无意义的Select操作，运行效率大幅提升，也避免了表切换导致的bug

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