Snasui Excel Forum

Code: Select all

Public Sub update()
 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

Code: Select all

Public Sub update()
    Dim rall As Range, r As Range
    Dim rtargetAll As Range
    With Sheets(1)
        Set rall = .Range("c2", .Range("c" & .Rows.Count).End(xlUp))
    End With
    For Each r In rall
        With Sheets(2)
            If .Range("a2").Value = "" Then
                Set rtargetAll = .Range("a2")
            Else
                Set rtargetAll = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
            End If
        End With
        If Application.CountIf(rall, r.Value) > 1 And Application.CountIf(rtargetAll, r.Value) = 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
                .Offset(0, 4).Value = Application.CountIf(rall, r.Value)
            End With
        End If
    Next r
End Sub