Salvare foglio excel con nome di caselle

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Pth As String, Fll As String
Application.EnableEvents = False
    Pth = Application.InputBox("Inserire la directory")
        Fll = Pth & Cells(1, 1) & "-" & Day(Cells(1, 2)) & "-" & Month(Cells(1, 2)) & "-" & Year(Cells(1, 2)) & ".xlsm"
Application.DisplayAlerts = False
        ChDir Pth
    ActiveWorkbook.SaveAs Filename:=Fll
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub