Ordenar Folhas Excel de forma Automatizada (Macro)

Pretende-se com esta macro Ordenar as Folhas de um livro de Excel de forma ascendente.

Video que mostra como fazer:

Código:

Option Explicit
Sub OrdenarFolhas()
'Esta rotina coloca as folhas de Excel por ordem ascendente

Dim NomeFolhas() As String
Dim ContarFolhas As Long
Dim i As Long
Dim AntigaFolhaActiva As Object

'Se não houver folha activa
If ActiveWorkbook Is Nothing Then Exit Sub

'Verifica se a estrutura do livro esta protegida, se sim, não consegue ordenar e
'devolve uma mensagem ao utilizador
If ActiveWorkbook.ProtectStructure Then
MsgBox ActiveWorkbook.Name & " está protegida, ", vbCritical, "Não é possivel ordenar as folas. "
Exit Sub

End If

'Verifica se o utilizador quer mesmo fazer a ordenação
If MsgBox("Pretende ordenar as folhas deste livro de Excel?", vbQuestion + vbOKCancel) <> vbOK Then Exit Sub

'Desactiva o CTRL+BREAK (opção cancelar)
Application.EnableCancelKey = xlDisabled

'Vai buscar o numero de folhas existentes
ContarFolhas = ActiveWorkbook.Sheets.Count

'Redimensiona a Array
ReDim NomeFolhas(1 To ContarFolhas)

'Armazena uma referência da folha activa
Set AntigaFolhaActiva = ActiveSheet

'Preenche a array com os nomes das folhas
For i = 1 To ContarFolhas
NomeFolhas(i) = ActiveWorkbook.Sheets(i).Name
Next i

'Coloca a array na ordem ascendente
Call BubbleSort(NomeFolhas)

'Desactiva a actualização de ecran
Application.ScreenUpdating = False

'Move/Ordenas as folhas
For i = 1 To ContarFolhas
ActiveWorkbook.Sheets(NomeFolhas(i)).Move _
before:=ActiveWorkbook.Sheets(i)
Next i

'Reactiva a folha original
AntigaFolhaActiva.Activate

End Sub

Sub BubbleSort(List() As String)
'Função criada para ordenar as folhas e que é chamada em cima

Dim primeiro, Ultimo As Long
Dim i, j As Long
Dim Temp As String

primeiro = LBound(List)
Ultimo = UBound(List)

For i = primeiro To Ultimo - 1
For j = i + 1 To Ultimo
If List(i) > List(j) Then
Temp = List(j)
List(j) = List(i)
List(i) = Temp
End If
Next j
Next i
End Sub