VBA problem

[Paul_Hossler]

I'd do something like this

Option Explicit


Sub find_and_copy()
    Dim rFrom As Range, rTo As Range, r As Range
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Dim n As Long


    Set wsFrom = Worksheets("From")
    Set wsTo = Worksheets("To")


    Set rFrom = wsFrom.Cells(1, 1).CurrentRegion
    Set rFrom = rFrom.Cells(2, 1).Resize(rFrom.Rows.Count - 1, rFrom.Columns.Count)


    Set rTo = wsTo.Cells(1, 1).CurrentRegion


    For Each r In rFrom.Columns(1).Cells
        
        n = 0
        On Error Resume Next
        n = Application.WorksheetFunction.Match(r.Value, rTo.Columns(1), 0)
        On Error GoTo 0
        
        If n > 0 Then
            If Application.WorksheetFunction.CountA(rTo.Rows(n)) > 1 Then
                MsgBox r.Value & " in row " & n & " already has data"
                
            Else
                r.EntireRow.Copy wsTo.Cells(n, 1)
            End If
        End If
    Next
    
    Application.ScreenUpdating = True
    MsgBox "Finito"
        
End Sub