Macro enregistrement pdf dossier spécifique

Bonjour,

J'ai une macro qui me permet de faire un PDF d'une plage prédéfinie et de l'enregistrer dans un dossier prévu pour. Puis d'actualiser cette plage à l'aide d'un menu déroulant et de répéter l'opération.

Elle marche très bien, j'aimerai juste pousser le bouchon plus loin en lui demandant quand elle enregistre un fichier avec nom = CCM par exemple, alors elle cherche si il y a un dossier qui a le même nom, si oui elle l'enregistre dedans, sinon elle le crée et l'enregistre dedans.

Je suis pas expert, je bidouille juste quelques trucs et je suis arrivé à cela, et depuis je bloque, mon MkDir ne marche pas.

Pouvez-vous m'aider svp ?

Sub Impression_PDF_Janvier()

Dim cell As Range
For Each cell In Range("TRANSPORTEUR")
Range("LISTE1").Value = cell
Application.Run ("pdf_janvier")
Next cell
MsgBox ("Terminé")
End Sub


Sub pdf_janvier()

Sheets("Edition transporteurs").Select
Dim GestionFichier As New Scripting.FileSystemObject
' On commence par définir une variable de type Folder :
Dim Dossier As Folder, res As String, CodeTPT As String, chemin As String
Dim Creation As String
Dim Mon_Transporteur As String
Mon_Transporteur = Range("LISTE1").Value
Application.Goto Reference:="SUIVI1"
CodeTPT = ActiveSheet.Range("G260")
nomTPT = ActiveSheet.Range("I260").Value
nomfichier = CodeTPT & "-" & nomTPT & ".pdf"
chemin = "C:\Users\mb\Test"

' Cette boucle parcourt tous les dossiers
For Each Dossier In GestionFichier.GetFolder(chemin).SubFolders
res = Left(Dossier.Name, CodeTPT)
If res = CodeTPT Then


Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
nomfichier & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=1, OpenAfterPublish:=False _

Set GestionFichier = Nothing
Exit Sub
End If
Next
' si le dossier n'existe pas création
Creation = chemin & CodeTPT & " - " & nomTPT & "\"
MkDir (Creation)
Set GestionFichier = Nothing
End If


End Sub

Windows / Edge 108.0.1462.76