ترتيب أوراق العمل تصاعدياً أو تنازلياً Sort Worksheets Ascending Or Descending

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

إليكم كود يمكنك من ترتيب أوراق العمل إما ترتيب تصاعدي Ascending أو ترتيب تنازلي Descending.

عند تنفيذ الكود تظهر رسالة بهذا الشكل :

بالنقر على الخيار Yes يتم ترتيب أوراق العمل ترتيب تصاعدي

وبالنقر على الخيار No يتم ترتيب أوراق العمل ترتيب تنازلي

وبالنقر على الخيار Cancel يتم الخروج من الإجراء الفرعي بدون ترتيب لأوراق العمل

إليكم الكود المستخدم ، ويوضع الكود في موديول عادي :

Sub Sort_Worksheets()
    Dim I As Integer
    Dim J As Integer
    Dim iAnswer As VbMsgBoxResult

    iAnswer = MsgBox("Sort Sheets In Ascending Order?" & Chr(10) & "Clicking No Will Sort In Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
    
    For I = 1 To Sheets.Count
        For J = 1 To Sheets.Count - 1
            If iAnswer = vbYes Then
                If UCase$(Sheets(J).Name) > UCase$(Sheets(J + 1).Name) Then
                    Sheets(J).Move After:=Sheets(J + 1)
                End If
            ElseIf iAnswer = vbNo Then
                If UCase$(Sheets(J).Name) < UCase$(Sheets(J + 1).Name) Then
                    Sheets(J).Move After:=Sheets(J + 1)
                End If
            End If
        Next J
    Next I
End Sub

تحميل الملف من هنا

إعداد / ياسر خليل أبو البراء