gustavo.silva,

Bom dia!

Supondo que o nome do arquivo esteja na célula A1, use assim:

    ChDir ActiveWorkbook.Path
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "" & Range("A1").Value & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

Olá Wagner!
Este código já utilizei, mas não deu certo...

Pessoal, estou quase lá...

Sub SaveAsName()
Dim save_as As Variant
Dim file_name As String
Dim ProgramName As String

file_name = Range("S1").Value
    ' Get the file name.
    save_as = Application.GetSaveAsFilename(Range("S1").Value, _
        FileFilter:="Excel Files,*.xlsx,All Files,*.*")
    ' See if the user canceled.
    If save_as = False Then Exit Sub
    ' Save the file with the new name.
    Application.DisplayAlerts = False
    If LCase$(Right$(save_as, 4)) <> ".xlsxm" Then
        file_name = save_as & ".xlsxm"
    End If
    ActiveWorkbook.SaveAs FileName:=save_as, FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    
End Sub

Porém, salva em formato Excel e não em formato com macro...

Erro 400...

Vc deveria usar o controle de versão do Office.

Resolvido...

Sub SaveBudget()
Dim save_as As Variant
Dim file_name As String
Dim ProgramName As String

file_name = Range("P1").Value

    save_as = Application.GetSaveAsFilename(Range("P1").Value, _
        FileFilter:="Excel Files,*.xlsm,All Files,*.*")

    If save_as = False Then Exit Sub

    Application.DisplayAlerts = False
    If LCase$(Right$(save_as, 4)) <> ".xlsm" Then
        file_name = save_as & ".xlsm"
    End If
    ActiveWorkbook.SaveAs filename:=save_as, FileFormat:=52, CreateBackup:=False
    
    
End Sub