Salvare un file excel con contenuto di più celle, scegliendo però destinazioni diverse per il salvataggio

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Titolo As String, Messaggio As String, Default As String, Pth As String
Const est As String = ".xlsm"
    Titolo = "Salva File"
    Messaggio = "Directory nella quale salvare il File."
        Pth = Application.InputBox(Messaggio, Titolo, Default)
            Pth = Pth & Cells(2, 1).Value & " " & Cells(2, 2).Value & " " & Cells(2, 3).Value & est
        MsgBox Pth
        ActiveWorkbook.SaveAs Filename:=Pth
End Sub