Snasui Excel Forum

Code: Select all

Sub test0()
    Dim rall As Range, r As Range
    Dim rtargetAll As Range, rtarget As Range
    
    Set rtargetAll = Sheets(2).Range("a:a")
    With Sheets(1)
        Set rall = .Range("c6", .Range("c" & .Rows.Count).End(xlUp))
        For Each r In rall
            If Application.CountIf(rtargetAll, r) = 0 Then
                With Sheets(2).Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
                    .Value = r.Value
                    .Offset(0, 1).Value = r.Offset(0, 1).Value
                    .Offset(0, 2).Value = r.Offset(0, 2).Value
                    .Offset(0, 3).Value = r.Offset(0, 3).Value
                End With
            End If
        Next r
    End With
End Sub