كود ترتيب الصفحات من الاصغر الى الاكبر

[رشبد]

السلام عليكم ورحمة الله

الاخوة الكرام

عندي ملف اكسيل يحتوي اكثر من 300 صفحة التسمية بالارقام من 1 الى اخر رقم باستثناء الصفحة الرئيسية  و تجميع 

وجزاكم الله خيرا

Book1.xlsm

تم تعديل منذ 3 ساعات بواسطه رشبد

[عبدالله بشير عبدالله]

وعليكم السلام ورخمة الله وبركاته

اليك الكود

Sub ترتيب_الصفخات()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorHandler
    
    Dim ws As Worksheet
    Dim dict As Object
    Dim key As Variant
    Dim sortedKeys() As Variant
    Dim i As Long, j As Long
    Dim temp As Variant
    Dim excludedSheets As Collection
    Dim mainSheet As String
    
    mainSheet = "الرييييسية"
    
    Set excludedSheets = New Collection
    excludedSheets.Add mainSheet
    excludedSheets.Add "تجميع"
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    For Each ws In ThisWorkbook.Worksheets
        If Not IsInCollection(excludedSheets, ws.Name) Then
            If IsNumeric(ws.Name) Then
                dict.Add CLng(ws.Name), ws.Name
            End If
        End If
    Next ws
    
    sortedKeys = dict.Keys
    
    For i = LBound(sortedKeys) To UBound(sortedKeys) - 1
        For j = i + 1 To UBound(sortedKeys)
            If sortedKeys(i) > sortedKeys(j) Then
                temp = sortedKeys(i)
                sortedKeys(i) = sortedKeys(j)
                sortedKeys(j) = temp
            End If
        Next j
    Next i
    
    For i = LBound(sortedKeys) To UBound(sortedKeys)
        Worksheets(dict(sortedKeys(i))).Move After:=Worksheets(Worksheets.Count)
    Next i
    
    Worksheets(mainSheet).Activate
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 '   MsgBox "تم ترتيب " & dict.Count & " ورقة رقمية بنجاح! ", vbInformation
    Exit Sub
    
ErrorHandler:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "حدث خطأ: " & Err.Description, vbCritical
End Sub

Function IsInCollection(col As Collection, item As String) As Boolean
    Dim obj As Variant
    On Error GoTo NotInCollection
    IsInCollection = True
    obj = col(item)
    Exit Function
NotInCollection:
    IsInCollection = False
End Function

ترتيب الصفحات.xlsm

[رشبد]

نعم هذا ما اريد بالظبط 

كيف التعديل لاضافة استثناءات اخرى مثلا اريد التعديل على الكود لاستثناء صفحات اخرى

جزاك الله خيرا استاد عبدالله بشير عبدالله