Microsoft 365 Projet VBA à affiner

'****************************************************
'enregistrer une fiche en pdf et une fiche en xlsx
'****************************************************
Sub EnregistrerFiche()
    Dim ws As Worksheet
    Dim nouveauClasseur As Workbook
    Dim chemin As String
    Dim nomFichier As String
    Dim compteur As Integer
    Dim dateActuelle As String
    Dim Shp As Shape
    ' Définir la feuille à copier
    ' adapter le nom e la feuille selon type de zone
    Set ws = ThisWorkbook.Sheets("Zone0")
    ' Définir le chemin où enregistrer les fichiers
    'adapter le chemin selon choix emplcement
    chemin = "C:\Users\Julia\Documents\Bjn Bionet\"
    ' Initialiser le compteur
    compteur = 1
    ' Obtenir la date actuelle au format JJMMYYYY
    dateActuelle = Format(Date, "dd mm yyyy")
    ' Générer un nom de fichier unique avec la date et incrémentation
    Do While Dir(chemin & dateActuelle & "_Fiche" & compteur & ".xlsx") <> ""
        compteur = compteur + 1
    Loop
    nomFichier = dateActuelle & "_Fiche" & compteur
    ' Copier la feuille dans un nouveau classeur
    ws.Copy
    ' Définir ce nouveau classeur actif
    Set nouveauClasseur = ActiveWorkbook
    ' Supprimer les bouton
    For Each Shp In nouveauClasseur.Sheets(1).Shapes
      Shp.Delete
    Next Shp
    ' Supprimer les colonnes
    Application.EnableEvents = False
    ActiveSheet.Columns("N:Q").Delete
    Application.EnableEvents = True
    ' Zone d'impression pour 1 seule page
    ActiveSheet.PageSetup.PrintArea = "$A$1:$L$28"
    ' Enregistrer en format XLSX
    'On Error GoTo ErreurEnregistrement
    Application.DisplayAlerts = False
    nouveauClasseur.SaveAs Filename:=chemin & nomFichier & ".xlsx", FileFormat:=51   ' xlOpenXMLWorkbook
    ' Enregistrer en format PDF
    nouveauClasseur.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomFichier & ".pdf"    ' xlTypePDF
    Application.DisplayAlerts = True
End Sub