Макрос для сортировки листов в excel

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

Sub Sortirovka_Listov_Po_Ubyvaniyu()
    Dim i As Integer
    Dim j As Integer
        For i = 1 To Sheets.Count
            For j = 1 To Sheets.Count - 1
                If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
                    Sheets(j).Move After:=Sheets(j + 1)
                End If
            Next j
        Next i
End Sub

Другие материалы по теме:

• Download sheetsort

Imagine that you have a large file with 20 or more worksheets. It could be, for instance, a file with snapshot financial models for the companies in your coverage universe or a breakdown of home sales in different regions of the city.

You want to sort these worksheets into some kind of order that would allow you and your team to access your data more quickly. The SortSheets macro will help you to sort your sheet tabs into any kind of order or metric you want (e.g., alphabetically, by ranking, etc.) using the qsort algorithm (an explanation of the algorithm can be found at http://en.wikipedia.org/wiki/Quicksort).

Exhibit 1A: A sample file with multiple worksheets (unsorted)

Exhibit 1B: A sample file with multiple worksheets (sorted)

Exhibit 2: SortSheets macro (VBA)  

Sub SwapSheets(S1 As Integer, S2 As Integer)
        Dim Sh1 As Worksheet, Sh2 As Worksheet
        Set Sh1 = Sheets(S1)
        Set Sh2 = Sheets(S2)
        Sh1.Move Before:=Sh2
        Sh2.Move Before:=Sheets(S1)
End Sub

Function QSortPartitionSheets(L As Integer, R As Integer, 
                                Pvt As Integer) As Integer
        Dim PivotValue As String
        Dim SI As Integer, I As Integer
        PivotValue = Sheets(Pvt).Name
        SwapSheets Pvt, R
        SI = L
        For I = L To R - 1
                If Sheets(I).Name <= PivotValue Then
                        SwapSheets I, SI
                        SI = SI + 1
                End If
        Next
        SwapSheets SI, R
        QSortPartitionSheets = SI
End Function

Sub QSortSheets(L As Integer, R As Integer)
        Dim Pvt As Integer
        Dim NewPvt As Integer
        If R > L Then
                NewPvt = QSortPartitionSheets(L, R, L)
                QSortSheets L, NewPvt - 1
                QSortSheets NewPvt + 1, R
        End If
End Sub

Public Sub SortSheets()
        QSortSheets 1, Sheets.Count
End Sub

The code in Exhibit 2 allows you to sort your worksheets alphabetically. To sort by some other metric (e.g. ranking, regional sales numbers, etc.), simply change QSortPartitionSheets to use variants instead of strings, and define a function to lookup the value using the sheet name (as demonstrated in Exhibit 3).

Exhibit 3: Modified QSortPartitionSheets (VBA)

Function YourFunction(SheetName As String) As Variant


End Function

Function QSortPartitionSheets(L As Integer, R As Integer, 
        Pvt As Integer) As Integer
        Dim PivotValue As Variant
        Dim SI As Integer, I As Integer
        PivotValue = YourFunction(Sheets(Pvt).Name)
        SwapSheets Pvt, R
        SI = L
        For I = L To R - 1
                If YourFunction(Sheets(I).Name) <= PivotValue Then
                        SwapSheets I, SI
                        SI = SI + 1
                End If
        Next
        SwapSheets SI, R
        QSortPartitionSheets = SI
End Function