Aynı veriden varsa yapıştırmasın

[vurkan]

Arkadaşlar Merhaba. İnternet Adreslerini biriktirdiğim (sık kullanılanlara benzer) bir excel dosyam var. İnternetten kopyaladığım verileri B sütununa yapıştırıyorum. Aradığımı daha kolay bulurum diye Sayfanın kod bölümüne yapıştırdığım;

Private Sub Worksheet_Change(ByVal Target As Range)
Columns("B:B").Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub

Kodlarıyla bu verileri sıralatıyorum. Şimdi yapmak istediğim;

Diyelim ki bir veriyi kopyaladım ve yapıştırdım. Eğer bu veriden B sütununda var ise aynı veriden var deyip yapıştırmasın. Yoksa yapıştırsın. Sıralama kodu çalıştıktan sonra B sütunudaki ilk boş hücre seçili hale gelsin. Şimdiden teşekkürler.


https://www.dosyaupload.com/aaun

 

[turist]

Aşağıdaki kodu deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
Dim say, son As Long
say = WorksheetFunction.CountIf(Columns("B"), Target.Value)
If say > 1 Then: Target.Clear
    Columns("B:B").Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        son = Cells(Rows.Count, "B").End(xlUp).Row + 1
        Range("B" & son).Select
End Sub

 

[vurkan]

Üstadım ilgi ve yardımın için teşekkür ederim. Hayırlı akşamlar.

 

[turist]

Sağ olun, iyi çalışmalar.

 

[yyhy]

Güzel bir çalışma olmuş acaba mesaj ile uyarı bölümü de eklenebilir mi?