跨工作表For循环复制数据遇运行时错误，求VBA代码排查

问题根源 #

你遇到的问题确实和工作表激活有关，但本质是未明确指定Cells对象所属的工作表。在你的代码里：

wh1.Range(Cells(i, 2), Cells(i, 2)).Copy

这里的Cells(i,2)默认会引用当前活动工作表的单元格，而不是wh1（"Data"工作表）的单元格。如果运行代码时活动工作表是"Dashboard"，就会导致范围引用混乱，触发运行时错误。

修正后的代码 #

Option Explicit
Sub TeknikerData()
    Dim Lag As String
    Dim lr1 As Long
    Dim lr2 As Long
    Dim i As Integer
    Dim wh1 As Worksheet
    Dim wh2 As Worksheet
    
    ' 绑定工作表对象，加上ThisWorkbook避免引用其他工作簿
    Set wh1 = ThisWorkbook.Sheets("Data")
    Set wh2 = ThisWorkbook.Sheets("Dashboard")
    
    lr1 = wh1.Cells(wh1.Rows.Count, 4).End(xlUp).Row ' 明确指定Rows所属的工作表
    Lag = wh2.Cells(12, 1).Value
    
    ' 关闭屏幕更新，提升运行效率同时避免界面闪烁
    Application.ScreenUpdating = False
    
    For i = 2 To lr1
        If wh1.Cells(i, 4).Value = Lag Then
            ' 明确指定Range和Cells都属于wh1，彻底避免活动工作表干扰
            wh1.Range(wh1.Cells(i, 2), wh1.Cells(i, 2)).Copy
            ' 粘贴到wh2的目标位置
            wh2.Range("B50").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats
        End If
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    ' 清除剪贴板状态，避免后续操作受影响
    Application.CutCopyMode = False
End Sub

关键修改点 #

• 所有Cells、Rows对象都明确绑定到对应的工作表（比如wh1.Rows.Count而不是Rows.Count），彻底摆脱对活动工作表的依赖。
• 添加了屏幕更新开关，让代码运行更流畅，不会出现频繁的界面跳转。
• 最后恢复屏幕状态并清空剪贴板，优化整体使用体验。

进一步优化建议 #

如果只是复制公式和数字格式，还可以跳过剪贴板直接赋值，效率会更高：

' 替换原有的复制粘贴代码段
With wh2.Range("B50").End(xlUp).Offset(1, 0)
    .Formula = wh1.Cells(i, 2).Formula
    .NumberFormat = wh1.Cells(i, 2).NumberFormat
End With

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