Sub SauvPdf()
Dim NomDossier$, chemin$, w As Worksheet, dat As Date, a$(), n%
NomDossier = Application.InputBox("Nom du dossier", "Création du dossier", "Entrer le nom du dossier")
If NomDossier = "" Then Exit Sub
chemin = ThisWorkbook.Path & "\" & NomDossier & "\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du dossier s'il n'existe pas
For Each w In Worksheets
If IsDate(w.Cells(1)) And w.Cells(6, 1) <> "" Then
If dat Then If w.Cells(1) <> dat Then MsgBox "Les dates en A1 doivent être les mêmes !", 48: Exit Sub
dat = w.Cells(1)
ReDim Preserve a(n)
a(n) = w.Name
n = n + 1
End If
Next
Sheets(a).Select 'sélection multiple
ActiveSheet.ExportAsFixedFormat xlTypePDF, chemin & Format(dat, "yyyy-mm") & ".pdf"
Sheets(a(0)).Select
MsgBox "Le fichier PDF a été créé"
End Sub