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 |
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!