Tabellenblätter sortieren

Mit dieser kleinen Funktion können die Tabellenblätter einer Arbeitsmappe alphabetisch sortiert werden.

Da mir keine eingebaute Sortierfunktion für Variablen in VBA bekannt ist, erfolgt die Sortierung der Tabellenblattnamen in einem eigenen Tabellenblatt. Dieses Sortier-Tabellenblatt wird am Ende der Funktion wieder gelöscht.

Option Explicit
Option Base 1

'------------------------------------------------------------------
' Module    : SheetsSortieren
' DateTime  : 07.04.2009
' Author    : Tobias - tobiasschmid.de - vba-blog.de
' Purpose   : Enthält Sortierfunktion für Tabellenblätter
'------------------------------------------------------------------

'------------------------------------------------------------------
' Procedure : SheetsSortieren
' DateTime  : 07.04.2009
' Author    : Tobias - tobiasschmid.de - vba-blog.de
' Purpose   : Sortiert die Tabellenblätter der aktuellen Arbeitsmappe alphabetisch
'------------------------------------------------------------------
Sub SheetsSortieren()
    Dim strSheets() As String
    Dim shtSortSheet As Worksheet
    Dim rng As Range
    Dim i As Long

    On Error GoTo SheetsSortieren_Error

    ReDim strSheets(ActiveWorkbook.Sheets.Count, 1)

    With ActiveWorkbook
        'Namen der Tabellenblätter einlesen
        For i = 1 To .Sheets.Count
            strSheets(i, 1) = .Sheets(i).Name
        Next

        'Tabellenblatt anlegen -> in diesem Tabellenblatt erfolgt die Sortierung
        Set shtSortSheet = .Sheets.Add

        With shtSortSheet
            'Namen der Tabellenblätter in Tabellenblatt schreiben
            Set rng = .Range(.Cells(1, 1), .Cells(UBound(strSheets, 1), 1))
            rng = strSheets

            'Namen der Tabellenblätter alphabetisch sortieren und sortierte Liste in Variable schreiben
            rng.Sort key1:=rng(1, 1), order1:=xlAscending, header:=xlNo
            For i = 1 To UBound(strSheets, 1)
                strSheets(i, 1) = rng(i, 1)
            Next

            'Sortier-Tabellenblatt löschen
            Application.DisplayAlerts = False
            .Delete
            Application.DisplayAlerts = True
        End With

        'Tabellenblätter sortieren
        For i = 1 To UBound(strSheets, 1)
            .Sheets(strSheets(i, 1)).Move Before:=.Sheets(i)
        Next
    End With

SheetsSortieren_Exit:
    On Error Resume Next
    Set rng = Nothing
    Set shtSortSheet = Nothing

    On Error GoTo 0
    Exit Sub

SheetsSortieren_Error:
    If bolMsgs Then MsgBox "Error " & Err.Description
    GoTo SheetsSortieren_Exit
End Sub

Code eingefügt mit Syntaxhighlighter 4.15
AnhangGröße
SheetsSortieren.bas2.43 KB
Your rating: Keine Average: 5 (4 votes)