Option Explicit
Public Sub BlattSortierung()
Dim vX() As String, i As Integer
' Peter Haserodt 2004
'Nimmt hier das aktive Workbook und setzt voraus das nichts geschützt ist.
'Muss sonst angepasst werden
' Sortiert alle Blätter also auch z.B. Diagramme
On Error GoTo Fehler
With ActiveWorkbook
 ReDim vX(.Sheets.Count) ' Das Feld auf die Blattanzahl dimensionieren
 If .Sheets.Count = 1 Then Exit Sub ' Dann muss nicht sortiert werden
 For i = 1 To .Sheets.Count ' Das Feld mit den Blattnamen füllen
  vX(i) = .Sheets(i).Name
 Next i
 QuickSort_Feld vX, 1, .Sheets.Count, False ' Jetzt aufsteigend sortieren
 .Sheets(vX(1)).Move Before:=.Sheets(1) ' Das erste Blatt nach vorne
 For i = 2 To .Sheets.Count ' und jetzt die anderen
  .Sheets(vX(i)).Move After:=.Sheets(i - 1)
 Next i
End With
Exit Sub
Fehler:
MsgBox Err.Description
End Sub
Private Sub QuickSort_Feld(DasFeld, StartUnten, _
 EndeOben, Absteigend As Boolean)
'QuickSort Standard
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
 If Not Absteigend Then
  While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
   iUnten = iUnten + 1
  Wend
  While (iMitte < DasFeld(iOben) And iOben > StartUnten)
   iOben = iOben - 1
  Wend
 Else
  While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
   iUnten = iUnten + 1
  Wend
  While (iMitte > DasFeld(iOben) And iOben > StartUnten)
   iOben = iOben - 1
  Wend
 End If
 If (iUnten <= iOben) Then
  y = DasFeld(iUnten)
  DasFeld(iUnten) = DasFeld(iOben)
  DasFeld(iOben) = y
  iUnten = iUnten + 1
  iOben = iOben - 1
 End If
Wend
If (StartUnten < iOben) Then Call QuickSort_Feld(DasFeld, _
 StartUnten, iOben, Absteigend)
 If (iUnten < EndeOben) Then Call QuickSort_Feld(DasFeld, _
 iUnten, EndeOben, Absteigend)
End Sub