Alfabetik Sıralama Sorunu

[safir33]

Değerli dostlar;
Ekteki yaptığım çalışmada Ekle1 butonu ile bilgileri ekletip aynı zamanda sıralamasını yapabiliyorum. Bunu da Sayfa1' deki şu koda göre yapıyor;

Private Sub Worksheet_Change(ByVal Target As Range)
Set Rng = Range([a3], [a1000].End(3))
If Intersect(Rng, Target) Is Nothing Or Target.Count > 1 Then Exit Sub
Cancel = True
Application.ScreenUpdating = False
Rng.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
Application.ScreenUpdating = True
End Sub

Fakat bu işlemi Ekle2 (sayfa1'deki C sütunu için)ve Ekle3 (sayfa1'deki F sütunu için) butonları için yapmasını bilmiyorum. Zaten bu kodları da siteden yardım alarak sayenizde yaptım. Yardımcı olursanız sevinirim. Herkese iyi çalışmalar.

 

[turist]

Sayfa1 deki kodunuzu aşağıdaki gibi değiştirip deneyin.

Private Sub Worksheet_Change(ByVal Target As Range) ' BU KOD ALFABETİK SIRALAMA İÇİNDİR
        If Intersect(Range([a3], [F1000]), Target) Is Nothing Or Target.Count > 1 Then Exit Sub
    Cancel = True
    Application.ScreenUpdating = False
    Range([a3], [a1000].End(3)).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
        
    Range([c3], [c1000].End(3)).Sort Key1:=Range("C3"), Order1:=xlAscending, Header:=xlGuess
        
    Range([f3], [F1000].End(3)).Sort Key1:=Range("F3"), Order1:=xlAscending, Header:=xlGuess
        Application.ScreenUpdating = True
        
        Application.ScreenUpdating = True
    End Sub

 

[safir33]

Değerli hocam sonsuz teşekkürler. Çok yardımcı oldunuz.