Çoklu Yatay Sıralama

[kemalist]

Arkadaşlar Merhaba; elimdeki kod ile R2:AC2 arasında küçükten büyüğe bir yatay sıralamayı hücrelerdeki renkler değişmeden gerçekleştirebiliyorum.Benim istediğim bunu son satıra kadar tekrarlamak.Yardımınız için şimdiden teşekkür ederim.Örnek dosya ektedir.

 

[kemalist]

Sub YATAY_SIRALAMA()

    Range("R2:AC2").Select
    ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa2").Sort.SortFields.Add Key:=Range("R2:AC2") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa2").Sort
        .SetRange Range("R2:AC2")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("R3").Select
End Sub

 

[Korhan Ayhan]

Döngü ile rahatlıkla yapabilirsiniz.

Option Explicit

Sub Yatay_Sirala()
    Dim Veri As Range
    
    Application.ScreenUpdating = False
    
    For Each Veri In Range("R2:R" & Cells(Rows.Count, "R").End(3).Row)
        Veri.Resize(, 12).Sort , Key1:=Veri, Order1:=xlAscending, Orientation:=xlLeftToRight
    Next

    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[kemalist]

Teşekkürler Korhan Bey