Sayfaları sıralama...

[aliakgul]

Herkese iyi geceler diliyorum.
Çalışma kitabımdaki sayfaların isimleri, "liste","veri","ayar" gibi metinsel ifadelerden oluşan isimlerle birlikte nümerik değerlerden oluşan(12,34,45,66,143,175 gibi) isimlerden oluşmaktadır. Sayfaları makro ile sıralatmak istiyorum ancak
1.Sadece nümerik olarak isimlendirilmiş sayfaların sıralanmasını istiyorum.
2.Örneğin, "11,12,23,24,35,36,112,235,247 " şeklindeki değerleri,"11,12,112,23,235,24,247 şeklinde değil, sayma düzeninde sıralamasını istiyorum...
Teşekkür ederim...
Not:Forumda bulduğum örneklerde yukarıda bahsettiğim durumlar sözkonusu olduğu için yeniden sorma gereği duydum...

 

[Orion1]

Sub sayfa_sirala()
Dim i As Integer, x As Integer
ReDim myarr(Worksheets.Count)
For i = 1 To Worksheets.Count
    myarr(i) = Sheets(i).Name
Next i
For i = 1 To UBound(myarr)
    For j = i + 1 To UBound(myarr)
        If IsNumeric(myarr(i)) And IsNumeric(myarr(j)) Then
            If CInt(myarr(i)) > CInt(myarr(j)) Then
                x = CInt(myarr(i))
                myarr(i) = CInt(myarr(j))
                myarr(j) = x
            End If
        End If
     Next j
Next i
For i = 1 To UBound(myarr)
Sheets(CStr(myarr(i))).Move after:=Sheets(Worksheets.Count)
Next i
End Sub

 

[Ayhan Ercan]

Sayın Evren hocam, benimmi yalnışım var bilemedim ama kodlarınızı çalıştırdığım zaman sıralamayı doğru yapmadı..
Örnek olarak yarattığım sayfalar ve kodu çalıştırdıktan sonraki sıralanmış şekli aşağıdaki gibi oldu:

1-11-12-2-5-13-21-32-45-55-65

 

[Ayhan Ercan]

Sonraki üstüüste denemelerim ile sonuç aşağıdaki gibi oldu:

1--11-12-13-2-21-32-45-5-55-65

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki koduda kullanabilirsiniz.

Sub SAYFALARI_SIRALA()
    Application.ScreenUpdating = False
    Sheets.Add , After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Sayfalar"
    
    For X = 1 To Sheets.Count - 1
    Sheets("Sayfalar").Cells(X, 1) = Sheets(X).Name
    Next
    
    Sheets("Sayfalar").Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending
    
    For X = 1 To [A65536].End(3).Row
        Sheets(CStr(Sheets("Sayfalar").Cells(X, 1))).Move Before:=Sheets(X)
    Next
    
    Application.DisplayAlerts = False
    Sheets("Sayfalar").Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Orion1]

Sayın Evren hocam, benimmi yalnışım var bilemedim ama kodlarınızı çalıştırdığım zaman sıralamayı doğru yapmadı..
Örnek olarak yarattığım sayfalar ve kodu çalıştırdıktan sonraki sıralanmış şekli aşağıdaki gibi oldu:

1-11-12-2-5-13-21-32-45-55-65

Ayhan hocam haklısınız gözümden ufak bir ayrıntı kaçmış.2 numaralı mesajımı düzelttim.Tekrardan indirip denermisiniz.

 

[aliakgul]

Selamlar,
Dışarıda olduğum için mesajlara ancak yeni bakabildim.Sayın Gizlen,Sayın Ercan ve Sayın Ayhan ilginizden dolayı teşekkür ederim.Sağolun varolun.Nasip olursa akşam kodları uygulayıp sonuç hakkında sizi tekrar bilgilendireceğim.
Selam ve muhabbetle...

 

[janveljan]

Alternatif bir kodda benden

Sub sırala()
a = Worksheets.Count
k = 1
n = 1
onay = False
Do While k <= a - 1
    n = k + 1
    Do While n <= a
        If Val(Sheets(k).Name) > Val(Sheets(n).Name) Then
        Sheets(k).Move after:=Sheets(n)
        onay = True
        k = n
        n = k + 1
        Else: n = n + 1
        End If
    Loop
    If onay Then
    k = 1
    onay = False
    Else:
    k = k + 1
    End If
Loop
End Sub

 

[aliakgul]

Emeği geçen herkese teşekkür ederim. İstediğim sonucu elde ettim. Saygılar...

 

[Orion1]

Emeği geçen herkese teşekkür ederim. İstediğim sonucu elde ettim. Saygılar...

Hepimizin yolladığı farklı kodlardı.Hangi arkadaşımızın yolladığı kodlar sorunu çözdü?

 

[zefede]

tek numaralı ve çift numaralı sayfaları yazdırma

tek numaralı ve çift numaralı sayfaları excelde nasıl yazdırabilirim.
Bu yazdırma seçeneği word de var ancak excelde bulamadım
teşekkürler