Excel VBA循环复制问题：为何仅重复复制符合条件的最后一行？

你的代码核心问题出在复制目标范围的指定错误：

• 每次复制时，你把源数据指向了目标表中从第4行到FinalRow1的范围（比如A4:A&FinalRow1），而不是FinalRow1这一行的对应列。
• 循环过程中，虽然FinalRow1会递增，但每次复制操作都会覆盖从第4行开始的一段区域，最终只有最后一次循环的符合条件行数据会保留，且重复复制了对应次数。

Sub CopyRow()
    'Declare variables
    Dim sheetNo1 As Worksheet
    Dim sheetNo2 As Worksheet
    Dim FinalRow1 As Long ' 补充分量声明
    Dim Cell As Range
    
    '关闭屏幕更新提升运行效率
    Application.ScreenUpdating = False
    
    'Set variables
    Set sheetNo1 = Sheets("EA Log")
    Set sheetNo2 = Sheets("Commitments")
    
    ' 获取目标表的起始写入行（最后一行下方第一行）
    FinalRow1 = sheetNo2.Range("A" & sheetNo2.Rows.Count).End(xlUp).Row + 1
    
    '遍历EA Log表P列从第4行开始的有效数据行
    For Each Cell In sheetNo1.Range("P4:P" & sheetNo1.Cells(sheetNo1.Rows.Count, "P").End(xlUp).Row)
        '匹配"Signed"条件
        If Cell.Value = "Signed" Then
            '复制指定列到目标表的对应行，目标指向单个单元格而非范围
            sheetNo1.Range(sheetNo1.Cells(Cell.Row, 2), sheetNo1.Cells(Cell.Row, 3)).Copy _
                        Destination:=sheetNo2.Cells(FinalRow1, "A")
                        
            sheetNo1.Cells(Cell.Row, 14).Copy _
                        Destination:=sheetNo2.Cells(FinalRow1, "C")
                        
            sheetNo1.Cells(Cell.Row, 1).Copy _
                        Destination:=sheetNo2.Cells(FinalRow1, "E")
                        
            sheetNo1.Cells(Cell.Row, 25).Copy _
                        Destination:=sheetNo2.Cells(FinalRow1, "D")
            
            '更新下一次写入的行号
            FinalRow1 = FinalRow1 + 1
        End If
    Next Cell
    
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub

• 补全FinalRow1的变量声明，避免隐式类型错误
• 将复制目标从范围（如A4:A&FinalRow1）改为单个单元格（sheetNo2.Cells(FinalRow1, "A")），确保每一行数据写入到目标表的对应行
• 添加Application.ScreenUpdating = False关闭屏幕刷新，提升代码运行速度，最后再恢复

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