salva foglio con nome delle celle

Option Explicit


Sub CopiaESalvaInPathX()
    
 
 Application.ScreenUpdating = False
   'dichiarazioni delle variabili

   Dim wbOri As Workbook
   Dim wsOri As Worksheet
   Dim wbDest As Workbook
   Dim wsDest As Worksheet
   Dim Sh As Worksheet
   Dim sPath As String
   Dim sComm1, sComm2, sComm3, sComm4, sComm5, sComm6, sComm7 As String
   Dim sWS As String
   Dim sWB As String
   Dim sData As String
   Dim sNomeFile As String
   Dim nSfx As Long
   Dim nFogliNew As Long
   Dim oShp As Shape
   Dim savechanges As Long
   
   Dim estensione As String
   
   Const xlExcel8 As Long = 56
   Const xlOpenXMLWorkbook As Long = 51
 '
 '-------------------------------------------------------------------------------------
   'impostazioni applicazione
 
   With Application
     .DisplayAlerts = False
     .ScreenUpdating = False
     nFogliNew = .SheetsInNewWorkbook
     .SheetsInNewWorkbook = 1
      .EnableEvents = False '<<< aggiunto
                                           
   End With
   
 '-------------------------------------------------------------------------------------
   'set degli oggetti
   
   Set wbOri = ThisWorkbook
   Set wsOri = wbOri.ActiveSheet
   Set wbDest = Application.Workbooks.Add
    
   sWS = wsOri.Name
   
'-----------------------------------------------------------------------------------------
   
    sPath = "C:\Users\massimo\Desktop\moduli_salvati" 'casa_new
   
'---------------------------------------------------------------------------------------
'nomi celle nel nome di salvataggio

    'ActiveSheet.Cells(5, 4).Select D5
      
    sComm1 = ActiveSheet.Range("C3").Select
    sComm2 = ActiveSheet.Range("C4").Select
    sComm3 = ActiveSheet.Range("K3").Select
    sComm4 = ActiveSheet.Range("G4").Select
    
                     'sComm5 = ActiveSheet.Range("R3").Select
                     'sComm6 = ActiveSheet.Range("S3").Select
                     'sComm7 = ActiveSheet.Range("T3").Select
  
   sData = Format(Date, "dd-mm-yyyy")
   
                 'sWB = "commessa - " & sComm1 & " - " & sComm2 & " (" & sData & ")"
   
                 'sWB = "MODULO " & sComm1 & " - " & sComm2 & " - " & sComm3 & " - " & sComm4 & " " & _
                 'sComm5 & " - " & sComm6 & " " & sComm7 & " ( " & sData & " )"
   
   sWB = "MODULO " & sComm1 & " - " & sComm2 & " - " & sComm3 & " - " & sComm4 & " ( " & sData & " )"
   
'--------------------------------------------------------------------------------------

    wsOri.Copy before:=wbDest.Sheets(1)
   Set wsDest = wbDest.ActiveSheet
   
   wsDest.Unprotect "123456"
         
  '------------------------------------------------------------------------------------------
   'togliere l'istruzione successiva se il foglio salvato non deve essere protetto
   
   'wsDest.Protect "123456"
   
 '-------------------------------------------------------------------------------------------
  
   sPath = sPath & "\" & sWS
   
   For Each Sh In wbDest.Sheets
     If Sh.Name <> wsDest.Name Then
       Sh.Delete
     End If
   Next
   
 '-------------------------------------------------------------------------------------
   'controllo/creazione dir da nome foglio
 
   If Dir(sPath, vbDirectory) = vbNullString Then
     MkDir (sPath)
   End If
   
 '-------------------------------------------------------------------
 
  'loop per creazione nome file
   Do
     nSfx = nSfx + 1
     
     sNomeFile = sPath & "\" & sWB & " - " & sWS & " - " & nSfx & ".xls" '<<< formato salvataggio
     'sNomeFile = sPath & "\" & sWB & " - " & sWS & " - " & nSfx & ".xlsx" '<<< new formato
     
   Loop While Dir(sNomeFile) <> vbNullString
   
   'salvataggio file
   wsDest.SaveAs Filename:=sNomeFile

'----------------------------------------------------------
     
   Set wsOri = Nothing
   Set wbOri = Nothing
   Set wsDest = Nothing
   Set wbDest = Nothing
   
   With Application
     .ScreenUpdating = True
     .DisplayAlerts = True
     .SheetsInNewWorkbook = nFogliNew
      .EnableEvents = True
   End With

 
  Application.ScreenUpdating = True
  
 End Sub

    sPath = "C:\Users\massimo\Desktop\moduli_salvati\" & sComm5
    '---------------------------------------------------
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(sPath) Then
        FSO.CreateFolder sPath
    End If
    '---------------------------------------------------

    If Dir(sPath, vbDirectory) = vbNullString Then
        MkDir (sPath)
    End If