Código para classificar planilhas

Este código me foi enviado num dos grupos há algum tempo.
Penso eu que já deveria fazer parte dos comandos do Excel, haja vista a quantidade imensa de planilhas que é possível colocar dentro de uma única pasta.
Créditos: fabiomaurisantos@bol.com.br


Sub ClassificarPlanilhas()
' Rotina para classificar planilhas em ordem crescente
Dim SheetNames() As String
Dim i As Integer
Dim SheetCount As Integer
Dim VisibleWins As Integer
Dim Item As Object
Dim OldActive As Object ' Checa se as estruturas das planilhas estão protegidas
If ActiveWorkbook.ProtectStructure Then
MsgBox ActiveWorkbook.Name & " is protected.", vbCritical, "Cannot Sort Sheets"
Exit Sub
End If
' Disativa Ctrl+Break
Application.EnableCancelKey = xlDisabled
' Sai se a janela não estiver visivel
VisibleWins = 0
For Each Item In Windows
If Item.Visible Then VisibleWins = VisibleWins + 1
Next Item
If VisibleWins = 0 Then Exit Sub ' conta nº de planilhas
SheetCount = ActiveWorkbook.Sheets.Count
' Redimensiona o array
ReDim SheetNames(1 To SheetCount)
' grava o nome da planilha ativa
Set OldActive = ActiveSheet
' prepara um array com os nomes das planilhas
For i = 1 To SheetCount
SheetNames(i) = ActiveWorkbook.Sheets(i).Name
Next i
' calssifica este array
Call Classificar(SheetNames)
' desativa atualização de tela
Application.ScreenUpdating = False
' move as planilhas
For i = 1 To SheetCount
ActiveWorkbook.Sheets(SheetNames(i)).Move ActiveWorkbook.Sheets(i)
Next i
' seleciona a planilha que havia gravado
OldActive.ActivateEnd Sub

Sub Classificar(List() As String)'Classifica as planilhas em ordem crescente
Dim First As Integer, Last As Integer
Dim i As Integer, j As Integer
Dim Temp
First = LBound(List)
Last = UBound(List)
For i = First To Last - 1
For j = i + 1 To Last
If UCase(List(i)) > UCase(List(j)) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub