Private Sub CommandButton1_Click()
   Dim fs As Object
   Dim sPathDestinazione As String
   Dim sVecchioNome As String
   Dim sNuovoNome As String
   On Error Resume Next
   MkDir "G:Backup"                                                                               ' crea la Cartella di destinazione nel disco G " Posta”
   sPathDestinazione = "G:Backup"
   sVecchioNome = "E:CartellaA"                                                       ' percorso origine disco E " GIANNI "
   sNuovoNome = "E:CartellaA" & Format(Date, "_dd_mm_yyyy")      ' cambio nome del File aggiungendo la data
   Set fs = CreateObject("Scripting.FileSystemObject")                    ' crea oggetto in disco E
   fs.movefolder sVecchioNome, sNuovoNome
   fs.CopyFolder sNuovoNome, sPathDestinazione, True                 ' copia cartella nel disco G
   fs.movefolder sNuovoNome, sVecchioNome                                 ' rinomina il vecchio File(togliendo la data) nel disco G
   Set fs = Nothing
   proteggi
   Application.Quit
End Sub
Sub proteggi()
   For Each w In Worksheets
      w.Protect Password = "11822"
   Next w  
End Sub
Sub sproteggi()
    For Each w In Worksheets
       w.Unprotect Password = "11822"
    Next w
End Sub