求助：VBA循环跨工作表按条件复制粘贴数据失败问题

你的代码问题主要出在内层的j循环和目标行的管理上，咱们一步步拆解：

问题1：多余且错误的内层循环 #

你写的内层For j = 3 To countC1会让每一个符合条件的wMod.Range("A" & i)值，被重复复制到wRes的A3到AcountC1的所有单元格里。这就导致最后只有最后一个符合条件的值会留在这些位置，前面的都会被覆盖，完全不是你要的“逐行复制符合条件的数据”的效果。

问题2：没有独立跟踪目标行位置 #

你没有用一个变量来记录wRes中接下来要写入数据的行号，反而用了固定的范围循环，自然无法实现数据的依次追加。

修复后的代码 #

我们只需要去掉多余的内层循环，新增一个变量来管理目标行即可：

Dim destRow As Long
destRow = 3 ' 从wRes的A3开始写入

For i = 3 To countP
    If wMod.Range("B" & i).Value = 1 Then ' 建议加上.Value更严谨
        wMod.Range("A" & i).Copy wRes.Range("A" & destRow)
        destRow = destRow + 1 ' 写完一行后，目标行往下移一位
    End If
Next i

额外优化建议 #

如果只是复制单元格值，不用复制格式的话，可以直接赋值，比Copy方法更快：

Dim destRow As Long
destRow = 3

For i = 3 To countP
    If wMod.Range("B" & i).Value = 1 Then
        wRes.Range("A" & destRow).Value = wMod.Range("A" & i).Value
        destRow = destRow + 1
    End If
Next i

这样修改后，只要wMod的B列对应行是1，就会把A列的值依次写到wRes的A3开始的行里，不会再出现覆盖或者数量不对的问题了。

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