Option Explicit
Sub Sauve()
Dim Lettre&
ThisWorkbook.Save
On Error Resume Next
MkDir Feuil1.Range("A2") & "Gestion" 'crée le répertoire s'il n'existe pas
For Lettre = 65 To 90
CreateObject("Scripting.FileSystemObject").CopyFile _
Chr(Lettre) & ":\Gestion" & "\*", Feuil1.Range("A2") & "Gestion"
Next Lettre
MsgBox "Sauvegarde du répertoire Gestion effectuée avec succés !" _
& vbCrLf & " " & vbCrLf & "Emplacement: " _
& Feuil1.Range("A2") & "Gestion", vbInformation, " Copie " & ThisWorkbook.Name
Application.DisplayAlerts = True
'Application.Quit
ThisWorkbook.Close
End Sub