Tek olan verileri silme

[kimyacı1964]

Sayfa2 deki kod(D sütünunu) sütununda değerleri bir kez yazılan (mükerrer olmayan) olan verileri bulup A , M aralığındaki tüm bilgileri keserek sayfa1 e yapıştırmak istiyorum,
Teşekkürler

 

[kimyacı1964]

Mükerrer kayıt

Sayfa2 daki kod(D sütünunu) sütununda değerleri bir kez yazılan (mükerrer olmayan) olan verileri bulup A , M aralığındaki tüm bilgileri keserek sayfa1 e yapıştırmak istiyorum,
Teşekkürler

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim X As Long, Satir As Long
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    S1.Cells.Delete
    Satir = 1
    
    For X = 2 To S2.Cells(S2.Rows.Count, 1).End(3).Row
        If WorksheetFunction.CountIf(S2.Range("D:D"), S2.Cells(X, 4)) = 1 Then
            S2.Range("A" & X & ":M" & X).Cut S1.Cells(Satir, 1)
            Satir = Satir + 1
        End If
    Next

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kimyacı1964]

Mükemmel olmuş,Eline sağlık,Teşekkürler