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
