Mükerrer Kayıtları Bulma

[nihatra]

Kolay gelsin

Sayfa1' de A sütununda 1000 adet ad soyad B sütununda 1000 adet ad soyad var.

A ve B sütnundaki mükerrer isimleri bularak mükerrer olanları sayfa2 ye makro ile nasıl yazdırabilirim.

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim s1 As Worksheet: Set s1 = Sheets("Sayfa1")
    Dim s2 As Worksheet: Set s2 = Sheets("Sayfa2")
    
    s2.Range("A:A").ClearContents
    
    a = s1.Cells(Rows.Count, "A").End(3).Row
    b = s1.Cells(Rows.Count, "B").End(3).Row
    
    If a >= b Then
        Set alan = s1.Range("B:B")
        s = a
        süt = 1
    Else
        Set alan = s1.Range("A:A")
        s = b
        süt = 2
    End If
    
    sat = 1
    For i = 1 To s
        If WorksheetFunction.CountIf(alan, s1.Cells(i, süt)) > 0 Then
            s2.Cells(sat, "A") = s1.Cells(i, süt)
            sat = sat + 1
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .

 

[nihatra]

Teşekkür ederim elinize sağlık.