Çift Olanları silme

[siar]

Herkese Merhabalar,

Ekteki tablo gibi daha uzun listeler elimde mevcut ve bu tabloda çift olam mail adreslerini bulup, silmek istiyorum. Fakat çift olan mail adreslerini bir şekilde belirtmesi lazım.

Yani 2. sayfada çift adresler belirtilebilir, veya bir message box ile belirtilebilir. Yardımcı olabiliecek arkadaşlara şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub ÇİFT_OLANLARI_SİL_AKTAR()
    Application.ScreenUpdating = False
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    SATIR = 2
    S2.Columns(1).ClearContents
    S1.Select
    For X = [A65536].End(3).Row To 2 Step -1
    If WorksheetFunction.CountIf(Range("A1:A" & X), Cells(X, 1)) > 1 Then
    S2.Cells(SATIR, 1) = Cells(X, 1)
    Rows(X).Delete
    SATIR = SATIR + 1
    End If
    Next
    S2.Select
    Set S1 = Nothing
    Set S2 = Nothing
    Application.ScreenUpdating = True
    If [A2] = "" Then
    MsgBox "MÜKERRER KAYIT BULUNAMAMIŞTIR !", vbInformation
    End If
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[siar]

Elinize sağlık, tam istediğim gibi olmuş. Teşekkür ederim.