Sub PDF()
On Error Resume Next
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String, w As Worksheet
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
For Each w In Worksheets
If w.Name <> "Accueil" Then
Chemin = oFolderItem.Path & "\" & w.Name & "- Planning Individuel - " & Format(w.[c3], "mmmm yyyy") & ".xlsx"
End If
Next w
End Sub