Сортировка листов в Excel VBA

Sub Sort_Sheets()
    Dim i As Integer, j As Integer
    For i = 1 To Sheets.Count - 1
            For j = i + 1 To Sheets.Count
                If UCase(Sheets(i).Name) > UCase(Sheets(j).Name) Then
                    Sheets(j).Move before:=Sheets(i)
                End If
            Next j
     Next i
End Sub

Sub SortSheets()

    Dim I As Integer, J As Integer

    For I = 1 To Sheets.Count - 1

        For J = I + 1 To Sheets.Count

            If UCase(Sheets(I).Name) > UCase(Sheets(J).Name) Then

                Sheets(J).Move Before:=Sheets(I)

            End If

        Next J

    Next I

End Sub







От майкрософт




Sub Sort_Active_Book()
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
'
' Prompt the user as which direction they wish to
' sort the worksheets.
'
   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 the answer is Yes, then sort in ascending order.
'
         If iAnswer = vbYes Then
            If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
               Sheets(j).Move After:=Sheets(j + 1)
            End If
'
' If the answer is No, then sort in descending order.
'
         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

============================================

Сортировка по возрастанию

01.Sub Sortirovka_Listov_Po_Vozrastaniyu()

02.Dim i As Integer

03.Dim j As Integer

04.For i = 1 To Sheets.Count

05.For j = 1 To Sheets.Count - 1

06.If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then

07.Sheets(j).Move After:=Sheets(j + 1)

08.End If

09.Next j

10.Next i

11.End Sub

==========================================

Сортировка по убыванию

01.Sub Sortirovka_Listov_Po_Ubyvaniyu()

02.Dim i As Integer

03.Dim j As Integer

04.For i = 1 To Sheets.Count

05.For j = 1 To Sheets.Count - 1

06.If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then

07.Sheets(j).Move After:=Sheets(j + 1)

08.End If

09.Next j

10.Next i

11.End Sub