Macro para salvar aba excel em nova planilha - Nome da nova planilha

[beatrizf1307]

Olá pessoal,

Preciso de ajuda no código abaixo. O objetivo é salvar abas do excel em uma nova planilha individual para cada aba.
A macro roda bem, separa e salva os arquivos, o problema é que eu gostaria que os novos arquivos fossem salvos cada um com um nome diferente. O nome seria a célula B2 de cada sheet, porém não estou conseguindo acertar. Podem me ajudar por favor ? obrigada desde já

Sub SalvarAba()
'Impede que o Excel atualize a tela
Application.ScreenUpdating = False
'Impede que o Excel exiba alertas
Application.DisplayAlerts = False

'Seta uma variável para se referir a nova pasta de trabalho
Dim NovoWB As Workbook
'Cria esta nova aba
Set NovoWB = Workbooks.Add(xlWBATWorksheet)
With NovoWB
'Copia a aba atual para o novo arquivo, como a segunda aba
ThisWorkbook.ActiveSheet.Copy After:=.Worksheets(.Worksheets.Count)
'Deleta a primeira aba do arquivo criado (Aba em branco)
.Worksheets(1).Delete
'Salva o novo arquivo para a mesma pasta do arquivo atual
'Troque "Novo Arquivo" para um outro nome qualquer que preferir
.SaveAs ThisWorkbook.Path & "\Cota Outubro 21" & ".xlsx"
'Fecha o novo arquivo
.Close False
End With

'Permite que o Excel volte a atualizar a tela
Application.ScreenUpdating = False
'Permite que o Excel volte a exibir alertas
Application.DisplayAlerts = False
End Sub

[Reinaldo]

Uma possibilidade

Código: Selecionar todos

Sub SalvarAba()
Dim NewName As String
'Impede que o Excel atualize a tela
Application.ScreenUpdating = False
'Impede que o Excel exiba alertas
Application.DisplayAlerts = False

'Seta uma variável para se referir a nova pasta de trabalho
Dim NovoWB As Workbook
'Cria esta nova aba
Set NovoWB = Workbooks.Add(xlWBATWorksheet)
With NovoWB
NewName = ThisWorkbook.ActiveSheet.Range("B2").Value
'Copia a aba atual para o novo arquivo, como a segunda aba
ThisWorkbook.ActiveSheet.Copy After:=.Worksheets(.Worksheets.Count)
'Deleta a primeira aba do arquivo criado (Aba em branco)
.Worksheets(1).Delete
'Salva o novo arquivo para a mesma pasta do arquivo atual
'Troque "Novo Arquivo" para um outro nome qualquer que preferir
.SaveAs ThisWorkbook.Path & "\" & NewName & ".xlsx"
'Fecha o novo arquivo
.Close False
End With

'Permite que o Excel volte a atualizar a tela
Application.ScreenUpdating = False
'Permite que o Excel volte a exibir alertas
Application.DisplayAlerts = False
End Sub