O que segue, é a possibilidade de ordenarmos todas as worksheets (abas) contidas numa planilha (arquivo workbook).
Os nossos Dashboards e Scorecards contém diversas pastas num mesmo arquivo do MS Excel.
Em alguns casos precisamos deixar as abas organizadas, em especial no caso da geração automatizada de abas, geradas a partir das consultas efetuadas nos filtros dos Dashboards.
Sim, torna-se necessário que as nossas abas estejam organizada.
Claro que essa solução também será útil para os noobs que criarem várias pastas, impedindo que estes fiquem perdidos com várias abas nas nossas planilhas.
Esta funcionalidade automatiza a nossa necessidade de organização, fazendo todo o cansativo e enfadonho serviço de organização por nós, colocando as abas em ordem alfabética.
Apenas cole o código abaixo em um novo módulo da planilha que deseja organizar e faça chamadas a ele. Podem evocá-la na abertura e fechamento da mesma, ou através de um comando por combinação de teclas, um botão, ou o que desejar.
Option ExplicitFunction SheetsAlphaSort()' Author: Date: Contact:' André Bernardes 13/10/2008 11:07 bernardess@gmail.com' Ordena de forma alfabética todas as pastas em uma planilha MS Excel.Dim i As IntegerDim j As IntegerDim PrimPastaOrdenar As IntegerDim UltiPastaOrdenar As IntegerDim DescrescOrdem As BooleanLet DescrescOrdem = FalseIf ActiveWindow.SelectedSheets.Count = 1 Then
'Altera o 1 para o número da pasta que deseja ordenar primeiro.Let PrimPastaOrdenar = 1Let UltiPastaOrdenar = Worksheets.Count
Else
With ActiveWindow.SelectedSheets
For i = 2 To .CountIf .Item(i - 1).Index <> .Item(i).Index - 1 ThenMsgBox "Não há como ordenar PASTAS não-adjacentes!"Exit SubEnd IfNext iLet PrimPastaOrdenar = .Item(1).IndexLet UltiPastaOrdenar = .Item(.Count).Index
End With
End IfFor j = PrimPastaOrdenar To UltiPastaOrdenar
For i = j To UltiPastaOrdenar
If DescrescOrdem = True Then
If UCase(Worksheets(i).Name) > UCase(Worksheets(j).Name) Then
Worksheets(i).Move Before:=Worksheets(j)
End If
Else
If UCase(Worksheets(i).Name) < UCase(Worksheets(j).Name) Then
Worksheets(i).Move Before:=Worksheets(j)
End If
End If
Next i
Next jEnd Function
Deixe os seus comentários! Envie este artigo, divulgue este link na sua rede social...
Tags: VBA,
Nenhum comentário:
Postar um comentário