Excel VBA三工作表复制粘贴问题：代码仅匹配首个值即终止

嗨，我看你遇到的问题是VBA代码找到第一个满足条件的行后就停了，没法把所有符合条件的行都复制到第三个工作表里。这大概率是循环逻辑出了问题——要么是循环只跑了一次，要么是不小心加了提前退出循环的语句。

先给你梳理下核心问题：咱们要遍历所有符合条件的行，就得确保循环能覆盖第二个工作表的每一行，并且每次找到匹配项后不终止整个循环，继续往下找。

我先把你的代码补全并修改成能批量处理的版本，你可以根据实际情况调整细节：

Sub fallidas2()
    ' 定义工作表对象，方便后续调用，也避免拼写错误
    Dim wsFirst As Worksheet, wsSecond As Worksheet, wsTarget As Worksheet
    Dim lastRowFirst As Long, lastRowSecond As Long
    Dim i As Long, j As Long
    Dim targetRow As Long
    
    ' 替换成你实际的工作表名称
    Set wsFirst = Workbooks("modelo titulos UK").Worksheets("xlsConsu...") ' 第一个需要判断的工作表
    Set wsSecond = Workbooks("modelo titulos UK").Worksheets("你的第二个工作表名") ' 要复制数据的工作表
    Set wsTarget = ThisWorkbook.Worksheets("Failed_Trades") ' 目标工作表
    
    ' 获取两个源表的最后一行，确保循环覆盖所有数据
    lastRowFirst = wsFirst.Cells(Rows.Count, "A").End(xlUp).Row
    lastRowSecond = wsSecond.Cells(Rows.Count, "A").End(xlUp).Row
    
    ' 初始化目标行：从目标表已有数据的下一行开始
    targetRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    ' 遍历第二个工作表的每一行（假设第1行是表头，从第2行开始）
    For i = 2 To lastRowSecond
        ' 如果你的条件是对比第一个表和第二个表的内容，就用内层循环查找匹配
        For j = 2 To lastRowFirst
            ' ---------- 这里替换成你的实际条件判断 ----------
            ' 示例：第一个表的A列值等于第二个表的A列值
            If wsFirst.Cells(j, "A").Value = wsSecond.Cells(i, "A").Value Then
                ' 复制整行到目标表
                wsSecond.Rows(i).Copy Destination:=wsTarget.Rows(targetRow)
                ' 目标行号加1，准备下一次复制
                targetRow = targetRow + 1
                ' 如果每个第二个表的行只需要匹配一次第一个表的行，就退出内层循环
                Exit For
            End If
        Next j
    Next i
    
    ' 清理对象，释放内存
    Set wsFirst = Nothing
    Set wsSecond = Nothing
    Set wsTarget = Nothing
    
    MsgBox "所有符合条件的数据已复制完成！", vbInformation
End Sub

关键修改点说明： #

• 用工作表对象代替长名称：这样代码更易读，也不容易因为工作表名拼写出错
• 正确获取最后一行：确保循环能遍历所有有数据的行，不会遗漏
• 循环逻辑调整：外层循环遍历第二个工作表的每一行，内层循环（如果需要对比第一个表）查找匹配项，找到后复制并更新目标行号，然后继续下一行
• 移除错误的Exit For：如果之前你的代码里在If块后面加了Exit For且放在外层循环里，那就是导致只复制第一个的原因，现在把它移到内层循环（如果需要的话）

如果你的条件不需要对比第一个表，只是第二个表自身的某列满足条件（比如B列值为"失败"），那代码可以更简单：

Sub fallidas2()
    Dim wsSecond As Worksheet, wsTarget As Worksheet
    Dim lastRowSecond As Long
    Dim i As Long
    Dim targetRow As Long
    
    Set wsSecond = Workbooks("modelo titulos UK").Worksheets("你的第二个工作表名")
    Set wsTarget = ThisWorkbook.Worksheets("Failed_Trades")
    
    lastRowSecond = wsSecond.Cells(Rows.Count, "A").End(xlUp).Row
    targetRow = wsTarget.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For i = 2 To lastRowSecond
        ' 替换成你的实际条件，比如第二个表的B列值等于"Failed"
        If wsSecond.Cells(i, "B").Value = "Failed" Then
            wsSecond.Rows(i).Copy Destination:=wsTarget.Rows(targetRow)
            targetRow = targetRow + 1
            ' 这里绝对不能加Exit For！否则找到第一个就停了
        End If
    Next i
    
    Set wsSecond = Nothing
    Set wsTarget = Nothing
    
    MsgBox "数据复制完成！", vbInformation
End Sub

最后提醒： #

1. 一定要把代码里的"你的第二个工作表名"、"xlsConsu..."替换成你实际的工作表名称
2. 根据你的业务需求修改If语句里的条件判断（比如列号、判断逻辑）
3. 如果之前的代码里有导致循环提前终止的语句，记得删掉或者调整位置

内容的提问来源于stack exchange，提问作者Pinto André