Çalışma sayfası sekmelerini sıraya koyma

[serdarnkn]

Merhaba arkadaşlar,
Çalıştığım excel sayfasında, rakamlar vererek tanımladığım sekmeler var. Yeni sekmeleri çalışırken karışık olarak açıyorum. İş bittiği zaman bu çalışma sayfası sekmelerini artan sıraya göre sıralamam gerekiyor.
Nasıl bir makro yazabilirim?

 

[hamitcan]

Sub AlphabetizeWorksheets()
    Dim bSorted As Boolean
    Dim nSheetsSorted As Integer
    Dim nSheets As Integer
    Dim n As Integer
    Dim wb As Workbook
    
    Set wb = ActiveWorkbook
    nSheets = wb.Worksheets.Count
    nSheetsSorted = 0

    Do While (nSheetsSorted < nSheets) And Not bSorted
        bSorted = True
        nSheetsSorted = nSheetsSorted + 1
        For n = 1 To nSheets - nSheetsSorted
            If StrComp(wb.Worksheets(n).Name, wb.Worksheets(n + 1).Name, vbTextCompare) > 0 Then
                wb.Worksheets(n + 1).Move _
                    before:=wb.Worksheets(n)
                bSorted = False
            End If
        Next
    Loop
End Sub

 

[serdarnkn]

Çok teşekkür ederim hamitcan arkadaşım. Tam istediğim şey.
bununla ilgili birşey daha sormak istiyorum. Sıralama yaparkan
"profiller" isimli sekmeyi atlamasını istiyorum. yani sıralama yaparken "profiller" sekmesini sıralamasın.
şimdiden çok teşekkür ederim.

 

[hamitcan]

Bir şeyler yaptım.Bir deneyin.

Sub AlphabetizeWorksheets()
    Dim bSorted As Boolean
    Dim nSheetsSorted As Integer
    Dim nSheets As Integer
    Dim n As Integer
    Dim wb As Workbook
    
    Set wb = ActiveWorkbook
    nSheets = wb.Worksheets.Count
    nSheetsSorted = 0

    Do While (nSheetsSorted < nSheets) And Not bSorted
        bSorted = True
        nSheetsSorted = nSheetsSorted + 1
        For n = 1 To nSheets - nSheetsSorted
            If StrComp(wb.Worksheets(n).Name, wb.Worksheets(n + 1).Name, vbTextCompare) > 0 Then
                If wb.Worksheets(n + 1).Name = "profiller" Then GoTo atla
                    wb.Worksheets(n + 1).Move _
                    before:=wb.Worksheets(n)
                bSorted = False
            End If
atla:
        Next

    Loop
End Sub

 

[serdarnkn]

teşekkür ederim, gerçekten çok işime yaradı.