Création automatique de quittances de loyer annuel

Sub création()

'*** Effacement de feuilles existantes
If Sheets.Count > 1 Then ' si plus  d'une feuille on les effacetoutes sauf la 1ere
Application.DisplayAlerts = False 'désactive message de confirmation suppression
For n = Sheets.Count To 2 Step -1 ' boucle sur les feuilles et efface
Sheets(n).Delete
Next
Application.DisplayAlerts = True ' réactive message confirmation
End If

'*** création d'un dossier au nom du locataire
nomloc = Range("D6") ' récupère nom du locataire en cellule D6 A MODIFIER pour adapter
prenomloc = Range("D7")  ' récupère prenom du locataire en cellule D6 A MODIFIER pour adapter
nomdossier = nomloc & " " & prenomloc '  crée nom du dossier à créer en concaténant les 2
'chemin du dossier A MODIFIER pour adapter
chemindossier = "D:\1aout2017\Quittances\" & nomdossier 
'* vérification si le dossier existe déjà ou non
If Len(Dir(chemindossier, vbDirectory)) > 0 Then
      dossierexiste = True
   Else
      dossierexiste = False
End If

If dossierexiste = False Then MkDir (chemindossier & "\") ' création du dossier s'il n'existe pas

 chemin = chemindossier & "\" ' chemin avec nom du dossier créé au nom du locataire

'***  création des 11 autres feuilles mensuelles par copie de celle de janvier puis enregistrement de la feuille en PDF
For n = 1 To 11 ' boucle 11 fois
'** création
Sheets("Janvier").Select
    Sheets("Janvier").Copy After:=Sheets(Sheets.Count) ' copie janvier
    ' choix du mois à inscrire dans la feuille
    mois = Application.WorksheetFunction.Choose(n, "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre")
     With Sheets("Janvier (2)")
     .Activate ' activation de la feuille créée
     .Range("C3") = mois ' change le mois en C3
     .Name = mois 'renomme la feuille avec le nom du mois
  '** pdf
    
     cheminfeuille = chemin & ActiveSheet.Name & .Range("D3") & ".pdf" ' chemin complet en ajoutant le mois et l'année située en D3 (A MODIFIER pour adapter)et l'extension pdf
     'exportation feuille en pdf
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        cheminfeuille, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False ' pas d'ouverture du pdf après export
     End With
  '*** création du pdf pour janvier selon le même principe
     With Sheets("Janvier")
     .Activate
     cheminfeuille = chemin & ActiveSheet.Name & .Range("D3") & ".pdf"
     .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        cheminfichier, Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
     End With
Next

If dossierexiste = False Then mes = " Dossier " & nomdossier & " et 12 PDF créés" Else mes = "12 PDF créés dans le dossier " & nomdossier
MsgBox mes

    
End Sub