Soru Sayfaları harf sırasına göre sıralama

[NADİR YILDIZ]

Arkadaşlar makro ile sayfaları harf sırasına göre sıralıyorum. ben renksiz olan sayfalar olduğu yerde sabit kalsın.. diğer renkli sayfalar harf sırasına göre sıralasın istiyorum.
zaman içinde yeni renkli sayfa ekleme yapacağım.

iyi çalışmalar

 

[muygun]

Merhaba;
Mevcut kodlarınıza;

Private Sub CommandButton1_Click()
Dim Sort_Mode_Descending As Boolean
Dim No_of_Sheets As Integer
Dim Outer_Loop As Integer
Dim Inner_Loop As Integer
No_of_Sheets = Sheets.Count

Sort_Mode_Descending = False
For Outer_Loop = 1 To No_of_Sheets
If Sheets(Outer_Loop).Tab.ColorIndex = xlNone Then
For Inner_Loop = 1 To Outer_Loop
If Sort_Mode_Descending = True Then
If UCase(Sheets(Outer_Loop).Name) > UCase(Sheets(Inner_Loop).Name) Then
Sheets(Outer_Loop).Move Before:=Sheets(Inner_Loop)
End If
End If
If Sort_Mode_Descending = False Then
If UCase(Sheets(Outer_Loop).Name) < UCase(Sheets(Inner_Loop).Name) Then
Sheets(Outer_Loop).Move Before:=Sheets(Inner_Loop)
End If
End If
Next Inner_Loop
End If
Next Outer_Loop
End Sub

Koyu renkli satırları ekleyerek deneyin.
İyi çalışmalar.

 

[NADİR YILDIZ]

Sayın Muygun öncelikle teşekkür ederim
ancak benim istediğim renksiz olanlar sabit renkli olanları sıralama yapmak istiyorum.
makro kodunu eklediğim dosyamı paylaşıyorum.
benim atladığım bişey mi var acaba

iyi çalışmalar

 

[muygun]

Kodlardaki;

If Sheets(Outer_Loop).Tab.ColorIndex = xlNone Then
satırını
If Sheets(Outer_Loop).Tab.ColorIndex <> xlNone Then
şeklinde deneyin

 

[NADİR YILDIZ]

üstat yine olmadı maalesef

benim burada istediğim renksiz olanlar dosyada olduğu gibi aynı sırada kalacak
sayfa 1, olmayan kodlar,muhasebe,banka açıklama düzenlemesi,son extre bunlar bu sıra ile sabit kalacak
akbank extre ve sonrasındaki sayfalar alfabetik sıralama yapılacak
zaman zaman yukardaki sabit sayfalar haricinde yeni sayfalar ekliyeceğim.bunlarıda alfabetik sıralatmak istiyorum.
kısacası renksiz olanlar aynı şekilde sabit kalacak renkli olanlar ve bundan sonra ekleyeceklerim alfabetik sıralatmak istiyorum

iyi çalışmalar

 

[veyselemre]

Sub renkliSayfalariSirala()
    With CreateObject("system.collections.arraylist")
        For Each ws In ThisWorkbook.Sheets
            If ws.Tab.ColorIndex <> xlNone Then .Add ws.Name
        Next ws
        .Sort
        If .Count > 0 Then
            lst = .toArray
            For i = 0 To UBound(lst)
               Sheets(lst(i)).Move after:=Sheets(Sheets.Count)
            Next i
        End If
    End With
End Sub

 

[NADİR YILDIZ]

Veyselemre bey teşekkür ederim

evet istediğim gibi olmuş
ancak Muhasebe sayfasınıda sıralıyor
o sayfa renksizler gibi sabit kalacak bu kodda onuda sıralıyor.

İyi çalışmalar

 

[veyselemre]

Veyselemre bey teşekkür ederim

evet istediğim gibi olmuş
ancak Muhasebe sayfasınıda sıralıyor
o sayfa renksizler gibi sabit kalacak bu kodda onuda sıralıyor.

İyi çalışmalar

Demekki renksiz değilmiş, rengini silin.

 

[NADİR YILDIZ]

Evet Veysel bey oraya dikkat etmedim.

Teşekkür ederim.
Zahmet verdim

iyi çalışmalar

 

[NADİR YILDIZ]

Veysel bey yine ben
kusura bakmayın sizi uğraştırıyorum
orjinal dosyamda verdiğiniz makroyu eklediğimde hata veriyor

neden acaba ?

iyi çalışmalar

 

[veyselemre]

Hata vermedi bende ne hatası veriyor.

 

[NADİR YILDIZ]

son eklediğim dosyada aşağıdaki gibi hata veriyor

 

[Ziynettin]

@veysel bey bağlı değil aşağıdaki kod satırını ekleyiniz.

Dim ws As Worksheet, lst(), i As Long

 

[veyselemre]

Option Explicit var kodlarınızın başında

Private Sub CommandButton8_Click()
    Dim ws As Worksheet, lst As Variant, i&
    With CreateObject("system.collections.arraylist")
        For Each ws In ThisWorkbook.Sheets
            If ws.Tab.ColorIndex <> xlNone Then .Add ws.Name
        Next ws
        .Sort
        If .Count > 0 Then
            lst = .toArray
            For i = 0 To UBound(lst)
                Sheets(lst(i)).Move after:=Sheets(Sheets.Count)
            Next i
        End If
    End With
    Sheets("Muhasebe").Select
End Sub

 

[muygun]

Farklı bir yöntem alternatif olsun.
(Deminden beri beyaz renk verdiğiniz sayfalardaki hatayı arıyordum. Denemediğim yöntem kalmadı. Enson işlev makro ne varsa karıştırdım.)

NOT: veyselemre Bey'in kodlarını kullanın.
İyi çalışmalar.

 

[NADİR YILDIZ]

Teşekkürler veysel bey
Teşekkürler Ziynettin bey

Hakkınızı helal edin

iyi çalışmalar

 

[NADİR YILDIZ]

sayın muygun sizede teşekkür ederim

Hakkınızı helal edin

iyi çalışmalar