Private Sub CommandButton1_Click()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Const modele As String = _
"F:\Data\Feuilles de garde\Versaillesbis\modèle_VRS.xls"
Dim sDossier$, sDossier2$, i&, varAn, X, Y, Deb, Cpt&, Liste()
Liste = Array("", "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Aout", "Septembre", "Octobre", "Novembre", "Décembre")
Deb = Timer: varAn = Year(Date)
If varAn = 0 Then Exit Sub
X = DateSerial(varAn, 1, 1): Y = DateValue("31 décembre " & varAn)
Workbooks.Open modele
With ActiveWorkbook
sDossier = .Path & "\" & varAn
If Dir(sDossier, vbDirectory) = "" Then
MkDir sDossier
Else
rep = MsgBox("Le classeur " & varAn & " existe déja" _
& vbLf & "Voulez vous le remplacer ?", _
vbYesNo + vbExclamation + vbDefaultButton1, "Avertissement")
If rep <> vbYes Then .Close False: Exit Sub
End If
For i = 0 To Y - X
sDossier2 = sDossier & "\" & Liste(Month(X + i)) & "_" & varAn
.Sheets("01").Range("AK1") = Format(X + i, "mm/dd/yyyy")
If Dir(sDossier2, vbDirectory) = "" Then MkDir sDossier2
.SaveAs sDossier2 & "\" & Format(X + i, "dd_mmmm_yyyy") & ".xls"
Cpt = Cpt + 1
Next i
.Close True
End With
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "Traitement Terminé" & vbLf & _
Cpt & " Classeurs créés" & vbLf & _
"en " & Format(Timer - Deb, "0.00") & " Secondes"
End Sub