基于单元格值复制行：目标表空行定位及重复复制问题

解决方案 #

针对你的两个问题，以下是修改后的代码，同时支持插入到下一个可用空行或插入到工作表顶部两种模式，并且避免重复复制：

版本1：复制到目标表的下一个可用空行

Sub MoveRowBasedOnCellValue()
    Dim sourceWs As Worksheet, targetWs As Worksheet
    Dim lastSourceRow As Long, lastTargetRow As Long
    Dim i As Long
    Dim uniqueId As Variant
    Dim isDuplicate As Boolean
    
    ' 定义工作表
    Set sourceWs = ThisWorkbook.Worksheets("Quote Tracker")
    Set targetWs = ThisWorkbook.Worksheets("Cashflow")
    
    Application.ScreenUpdating = False
    
    ' 获取源表O列最后一行
    lastSourceRow = sourceWs.Cells(sourceWs.Rows.Count, "O").End(xlUp).Row
    
    ' 获取目标表A列最后一行（确保找到真正的空行）
    lastTargetRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
    ' 若目标表为空（仅表头或全空），重置行号为0
    If lastTargetRow = 1 And Application.WorksheetFunction.CountA(targetWs.Rows(1)) = 0 Then
        lastTargetRow = 0
    End If
    
    ' 遍历源表符合条件的行
    For i = 1 To lastSourceRow
        If CStr(sourceWs.Cells(i, "O").Value) = "75 - 100%" Then
            ' 假设A列为唯一标识（可根据实际修改为你的唯一列，如订单号列）
            uniqueId = sourceWs.Cells(i, "A").Value
            
            ' 检查目标表是否已存在该行的唯一标识
            isDuplicate = False
            On Error Resume Next
            isDuplicate = Not IsError(Application.Match(uniqueId, targetWs.Columns("A"), 0))
            On Error GoTo 0
            
            ' 非重复行则复制
            If Not isDuplicate Then
                sourceWs.Rows(i).Copy Destination:=targetWs.Cells(lastTargetRow + 1, "A")
                lastTargetRow = lastTargetRow + 1
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "操作完成！已将符合条件的非重复行复制到Cashflow工作表"
End Sub

版本2：复制到目标表的顶部（表头下方）

如果需要将新行插入到顶部（假设第1行为表头），使用以下代码：

Sub MoveRowToTop()
    Dim sourceWs As Worksheet, targetWs As Worksheet
    Dim lastSourceRow As Long
    Dim i As Long
    Dim uniqueId As Variant
    Dim isDuplicate As Boolean
    
    Set sourceWs = ThisWorkbook.Worksheets("Quote Tracker")
    Set targetWs = ThisWorkbook.Worksheets("Cashflow")
    
    Application.ScreenUpdating = False
    
    lastSourceRow = sourceWs.Cells(sourceWs.Rows.Count, "O").End(xlUp).Row
    
    ' 从下往上遍历，避免插入行后源表行号偏移
    For i = lastSourceRow To 1 Step -1
        If CStr(sourceWs.Cells(i, "O").Value) = "75 - 100%" Then
            uniqueId = sourceWs.Cells(i, "A").Value
            
            ' 检查重复
            isDuplicate = False
            On Error Resume Next
            isDuplicate = Not IsError(Application.Match(uniqueId, targetWs.Columns("A"), 0))
            On Error GoTo 0
            
            If Not isDuplicate Then
                ' 在表头下方（第2行）插入新行
                targetWs.Rows(2).Insert Shift:=xlDown
                sourceWs.Rows(i).Copy Destination:=targetWs.Rows(2)
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox "操作完成！已将符合条件的非重复行插入到Cashflow工作表顶部"
End Sub

关键修改说明 #

• 准确获取空行：替换UsedRange.Rows.Count为Cells(Rows.Count, "A").End(xlUp).Row，该方法从列A底部向上查找第一个非空单元格，避免因UsedRange包含已清空行导致的定位错误。
• 避免重复复制：通过Application.Match检查目标表中是否存在源行的唯一标识（可根据实际业务修改唯一列），仅复制不存在的行。
• 顶部插入处理：采用从下往上遍历源表的方式，避免插入行后源表行号偏移导致漏处理；固定在第2行插入，确保新行位于表头下方。

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