Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim NouvelleSauvegarde As String
NouvelleSauvegarde = CreerRep
ActiveWorkbook.SaveAs Filename:= _
NouvelleSauvegarde, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
end sub
Private Function CreerRep() As String
Dim leChemin as string
leChemin = activeworkbook.path & "\"
On Error Resume Next
MkDir leChemin & "sousdossierrecla"
leChemin = leChemin & "sousdossierrecla" & "\"
leChemin = leChemin & "Fiche" & Cstr(sheets("Feuil1").range("B3").value) & ".xls"
CreerRep = leChemin
End Function