Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminBase$, dossier As Range, i As Byte, nomfich$, ext$
CheminBase = "C:\Mes dossiers\" 'chemin à adapter
Set dossier = Feuil1.[A1] 'CodeName de la feuille
Cancel = True
For i = 1 To 9
If InStr(dossier, Mid("\/:*?""<>|", i, 1)) Then _
MsgBox "Caractère interdit !": dossier = ""
Next
nomfich = IIf(dossier = "", "", dossier & "_") & Format(Now, "yymmdd_hhmmss")
ext = Mid(Me.Name, InStrRev(Me.Name, "."))
On Error Resume Next
MkDir CheminBase & dossier 'création du dossier s'il n'existe pas
Application.DisplayAlerts = False
Application.EnableEvents = False
Me.Save 'enregistrement normal
Me.SaveCopyAs CheminBase & IIf(dossier = "", "", dossier & "\") & nomfich & ext
Application.EnableEvents = True
End Sub