Alfabetik sıralı benzersiz liste oluşturmak

[sward175]

Herkese merhabalar,
P11685 aralığında bulunan kodları, AY11' den aşağı doğru alfabetik sıralı benzersiz liste oluşturmak istiyorum. Yardımınızı rica ederim.
Saygı ve Sevgi ile,
sward175

 

[YUSUF44]

Öncelikle Makro Kaydet yoluyla elde ettiğim ve sonra düzenleme yaptığım aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub BenzersizSırala()
    eskiAY = WorksheetFunction.Max(Cells(Rows.Count, "AY").End(3).Row, 11) 'AY'nin son dolu satırını bulma
    Range("AY11:AY" & eskiAY).ClearContents 'AY'deki eski verileri silme
    eskiP = WorksheetFunction.Max(Cells(Rows.Count, "P").End(3).Row, 11) 'P'nin son dolu satırını bulma
    Range("P11:P" & eskiP).Copy: [AY11].PasteSpecial Paste:=xlValues 'P'deki verileri AY'ye aktarma
    ActiveSheet.Range("$AY$10:$AY$" & eskiP).RemoveDuplicates Columns:=1, Header:=xlYes 'AY'deki verileride yinelenenleri kaldırma
    ActiveSheet.Sort.SortFields.Clear 'Burdan sonrası sıralama
    ActiveSheet.Sort.SortFields.Add Key:=Range("AY10"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("AY11:AY" & eskiP)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("AY6").Select
End Sub

 

[sward175]

sayın: YUSUF44,
Evet aradığım bu idi işimi epey kolaylaştıracak.
Ne desem nasıl teşekkür etsem bilemiyorum. Yüce rabbim dileklerini kabul etsin.
Saygı ve sevgi ile.
sward175