请求排查VBA条件复制粘贴代码忽略条件的原因

以下是导致代码忽略条件、全量复制的核心问题：

• 致命赋值逻辑错误：当满足sourceRange.Cells(i, 2).Value = 3840条件时，你执行的是targetRange.Value = sourceRange.Value——这行代码是直接把整个源数据区域的内容一次性覆盖到目标区域，而非复制当前符合条件的单行。只要有任何一行满足条件，就会触发全量复制，这就是所有数据被粘贴的原因。
• 循环范围与索引错误：
  • nRows = Cells(sht.Rows.Count, "B").End(xlUp).Row里的Cells未指定所属工作表，默认会用当前活动工作表的行数，可能和源工作表实际行数不符；
  • 源区域是A3:T559，对应工作表行是3到559，但循环是For i = 1 To nRows，sourceRange.Cells(i,2)对应的是源区域的第i行（即工作表第3+i-1行），当i超过源区域行数（557行）时会越界，还会遍历到源区域外的行。
• 目标行跟踪缺失：没有维护变量记录目标区域的粘贴位置，直接覆盖整个目标区域，完全没实现“逐行筛选复制”的逻辑。
• 注释误导：代码注释写的是检查C列，但实际判断的是B列，虽不影响功能，但易造成后续维护混淆。

下面是修复所有问题的版本，实现只复制B列等于3840的行到目标工作表：

Sub CopyBasedOnCondition()
    Dim sourceSht As Worksheet
    Dim targetSht As Worksheet
    Dim targetRow As Long
    Dim i As Long
    Dim lastSourceRow As Long
    
    ' 定义工作表对象，避免活动表切换导致的错误
    Set sourceSht = Worksheets("Historical State ICI Gr Rate")
    Set targetSht = Worksheets("Very Small Systems")
    
    ' 获取源工作表B列最后一行的行号
    lastSourceRow = sourceSht.Cells(sourceSht.Rows.Count, "B").End(xlUp).Row
    ' 目标区域起始行设为3
    targetRow = 3
    
    ' 遍历源数据的有效行（从第3行到B列最后一行）
    For i = 3 To lastSourceRow
        ' 检查当前行B列的值是否为3840
        If sourceSht.Cells(i, "B").Value = 3840 Then
            ' 复制当前行A-T列数据到目标工作表对应行
            sourceSht.Range(sourceSht.Cells(i, "A"), sourceSht.Cells(i, "T")).Copy _
                Destination:=targetSht.Cells(targetRow, "A")
            ' 目标行自增，准备下一行粘贴
            targetRow = targetRow + 1
        End If
    Next i
    
    ' 清除剪贴板
    Application.CutCopyMode = False
End Sub

修正点说明 #

• 明确指定工作表对象，避免Cells/Range默认指向活动表的问题；
• 逐行判断后仅复制符合条件的单行数据，而非全量覆盖；
• 用targetRow变量跟踪目标工作表的粘贴位置，确保数据逐行追加；
• 循环范围精准对应源数据实际行，避免越界问题。

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