循环工作表时触发Runtime Error 1004，寻求技术排查建议

问题现象 #

• 在XD1111X工作表点击运行代码可正常执行，但无法循环到XD2222X、XD3333X等指定工作表
• 在其他工作表点击运行代码直接失效，触发Runtime Error 1004

错误根源 #

1. 依赖工作表激活状态，导致上下文混乱
   主过程LoopWorksheetsAndRunVBA里用ws.Range("A1").Activate激活工作表，但EachVeh过程又通过ActiveSheet.Name获取工作表名称——一旦MsgBox弹窗导致焦点切换，ActiveSheet会变成当前操作的工作表，而非循环中的目标表。
2. 不必要的Select/Selection操作
   VBA中Select/Selection是1004错误的常见触发点，跨工作表操作时，未确保目标表激活就执行Select会直接报错。
3. 参数传递未充分利用
   EachVeh已经接收了ws参数，但完全没用到，反而去取ActiveSheet.Name，违背了参数传递的设计逻辑。

修复后的完整代码 #

Sub LoopWorksheetsAndRunVBA()
    Dim ws As Worksheet

    ' 循环指定工作表
    For Each ws In ThisWorkbook.Worksheets(Array("XD1111X", "XD2222X", "XD3333X"))
        Call EachVeh(ws)
    Next ws
End Sub

Sub EachVeh(ws As Worksheet)
    Dim varResponse As Variant
    varResponse = MsgBox("是否清除数据?", vbYesNo, "警告")
    If varResponse <> vbYes Then Exit Sub

    ' 直接操作目标工作表，无需激活/选择
    ws.Range("A2:F1000").ClearContents

    Dim rng As Range, destRow As Long
    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim c As Range

    Set shtSrc = ThisWorkbook.Sheets("CALCULATE")
    Set shtDest = ws ' 直接使用传入的ws参数，避免依赖ActiveSheet

    destRow = 2 ' 数据起始行

    ' 设置要搜索的范围，避免空范围报错
    Set rng = Application.Intersect(shtSrc.Range("A1:A5000"), shtSrc.UsedRange)
    If rng Is Nothing Then Exit Sub ' 处理无数据的情况

    For Each c In rng.Cells
        If c.Value = ws.Name Then
            ' 直接复制，无需Select
            c.Resize(1, 7).Copy shtDest.Cells(destRow, 1)
            destRow = destRow + 1
        End If
    Next c
End Sub

关键修复说明 #

• 彻底移除对ActiveSheet的依赖：子过程直接使用传入的ws参数，不再通过ActiveSheet.Name获取工作表，避免焦点切换导致的上下文错误。
• 删除所有Select/Selection操作：直接对目标单元格/范围执行操作，比如ws.Range("A2:F1000").ClearContents替代原有的Select+ClearContents。
• 增加空范围判断：当shtSrc的A列无数据时，rng会是Nothing，提前退出避免循环报错。
• 移除不必要的工作表激活：主过程不再需要激活工作表，减少不必要的界面交互和潜在的焦点问题。

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