isim listesine benzersiz kayıt ekleme

[mozdem]

B sütununa daha önce yaptığım makro çalışması ile isimler yazılıyor. B sütunundaki listenin altına, G sütununnda bulunan liste eklenecek. Ancak B sütununda ki liste mükerrer olmayacak şekilde eklensin. Eklenip sonra mükerrer satırlar silinerek YAPILMASIN. istiyorum.

Yardımınız için şimdiden teşekkür ederim.

 

[Orion1]

Dosyanzı ektedir.

Sub benzersiz_ekle()
Dim sat As Long
Application.ScreenUpdating = False
sat = Cells(65536, "B").End(xlUp).Row + 1
For i = 16 To Cells(65536, "G").End(xlUp).Row
    If WorksheetFunction.CountIf(Range("B16:B" & sat - 1), Cells(i, "G").Value) = 0 Then
        Cells(sat, "B").Value = Cells(i, "G").Value
        sat = sat + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı.", vbOKOnly + vbInformation, "E V R E NM"
End Sub

 

[mozdem]

Teşekkür

Çok teşekkür ederim.
Ellerinize sağlık
Tam istediğim gibi

 

[Orion1]

Çok teşekkür ederim.
Ellerinize sağlık
Tam istediğim gibi

Rica ederim.
İyi çalışmalar.