Como Separar a Planilha de Excel com VBA?

Como Separar a Planilha de Excel com VBA?

Hoje vou mostrar uma função que criei para separar uma planilha em várias á partir de uma coluna com o ano e mês.

Para isso foi utilizado o seguinte código com os comentários:

'
'Divide a planilha em diversas a partir do critério do mês
Sub lsSeparaPlanilha()
    
    'Definição das Variáveis
    Dim iTotalLinhas As Integer
    Dim rngAux As Range
    Dim iAnoMes As String
    Dim lRow As Long
    Dim iTotalLinhasAux As Long
    Dim lCel As Long
    
    'Identifica a última linha da planilha
    iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row
    
    'Seleciona os dados das colunas
    Columns("A:F").Select
    
    'Realiza a ordenação dos dados pela data
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan1").Sort.SortFields.Add Key:=Range("F2:F" & iTotalLinhas) _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Plan1").Sort
        .SetRange Range("A1:F" & iTotalLinhas)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        
    'Analisa as linhas e as separa criando para isso novas planilhas
    For lCel = 2 To iTotalLinhas
        'Ativa a planilha da base de dados
        ActiveWorkbook.Worksheets("Plan1").Activate
        Set rngAux = Range("F" & CStr(lCel))
        
        'Cria uma nova planilha
        If Year(rngAux.Value) & "-" & Month(rngAux.Value)  iAnoMes Then
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(Year(rngAux.Value) & "-" & Month(rngAux.Value))
            iAnoMes = Year(rngAux.Value) & "-" & Month(rngAux.Value)
            ActiveWorkbook.Worksheets("Plan1").Activate
            Range("A1").EntireRow.Select
            Application.CutCopyMode = False
            Selection.Copy
            Sheets(CStr(iAnoMes)).Select
            Range("A1").Select
            ActiveSheet.Paste
        End If
        
        'Realiza a cópia dos dados
        ActiveWorkbook.Worksheets("Plan1").Activate
        rngAux.EntireRow.Select
        Application.CutCopyMode = False
        Selection.Cut
        Sheets(CStr(iAnoMes)).Select
        iTotalLinhas = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Range("A" & CStr(iTotalLinhas)).Select
        ActiveSheet.Paste
        
    Next lCel
    
    'Avisa o usuário o término do processo
    MsgBox "Planilha Separada", vbInformation
    '
End Sub

Então é isso, acredito que esta macro possa ser adaptada a outras necessidades com poucas alterações, e agradeço a sua visita.

Marcos Rieper