VBA – Salvando planilhas em arquivos separados no Excel (SplitSheets)

Mais uma do fórum. Pelo menos essa eu respondi. 😀

Se entendi bem a necessidade, o colega precisa salvar as planilhas de uma pasta trabalho em arquivos separados. Se forem muitas, a tarefa pode ficar, digamos, bem chata. Para variar, uma macro sempre ajuda.

O código abaixo, quando executado, salva cada uma das planilhas em um arquivo separado, na mesma pasta em que está salvo o arquivo original, com o nome da própria planilha:

Public Sub SplitSheetsToWorkbook()
    On Error GoTo TrataErro
 
    'variáveis
    Dim newBook As Workbook
    Dim sheet As Worksheet
    Dim i As Byte
 
    'Desativa os avisos e atualiação da tela
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    For Each sheet In ThisWorkbook.Worksheets
        'cria uma nova pasta de trabalho:
        Set newBook = Application.Workbooks.Add
        'copia a planilha
        sheet.Copy Before:=newBook.Sheets(1)
        'remove as outras
        For i = 2 To newBook.Worksheets.Count
            newBook.Worksheets(2).Delete
        Next i
        'salva o arquivo
        newBook.SaveAs Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & sheet.Name & ".xlsx"
        newBook.Close
    Next sheet
 
TrataSaida:
    'Reativa os avisos e atualiação da tela
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
    'zera as variáveis
    Set newBook = Nothing
    Set sheet = Nothing
 
    MsgBox "Feito!"
    Exit Sub
 
TrataErro:
    MsgBox Err.Description, vbCritical, "Erro"
 
    GoTo TrataSaida
End Sub

Há um tratamento de erro padrão para o Excel não se perder, já que durante a execução do código, alertas e atualizações da tela são desativadas.

Bom proveito!

Comentários

comentários