Création de plusieurs fichier pdfs avec une sélection de plusieurs onglets

Bonjour,

Après avoir longtemps chercher en vain la solution à mon problème j'espère que l'un de vous pourra m'aider.

J'ai un fichier avec une multitude d'onglets dans lesquels plusieurs sont rattachés à un même client. Le nombre d'onglets rattaché à un client varie dans le temps.

Je dois créer un fichier pdf pour chaque client avec tous les onglets associés à chaque client et cela consomme énormément de temps. Le nom de chaque onglet associé commence par le nom du client

Est-il donc possible d'avoir une macro qui :

- crée un fichier pdf pour chaque client rassemblant tous les onglets actifs associés

- Nommer chaque fichier avec un nom défini dans une cellule provenant d'une liste dans un onglet attitré

- Sauvegarder ces fichiers dans le dossier d'origine du fichier excel de base

J'avais en tête d'avoir un onglet liste résumant le nom de chaque client qui se retrouve également au début de chaque onglet associé ainsi que le nom du fichier pdf à créer. (voir exemple fourni).

Je ne sais pas du tout si cela est la meilleure des façons de fonctionner et je suis ouvert à vos suggestions.

Merci d'avance pour votre aide

Bonjour,

Des idées par rapport à cette question ?

Merci

Bonjour

Un fichier avec des données même fantaisistes serait pour le moins utile.

Bonjour,

En effet voici le fichier avec des données ajoutées.

Merci

Bonjour Plisson12, yal_excel, le forum,

Un essai .....

Il faut impérativement que les feuilles Client, Client Info et Client factures soient créées, que le client soit renseigné en colonne A et le nom du PDF en colonne B.

Il y a certainement moyen d'optimiser...où de simplifier ?

Sub PDF_V2()

  Dim client, Nom, F1 As String, F2 As String, F3 As String
  Dim i, j

  Application.ScreenUpdating = False

     j = 3 '.................................................ligne de départ
      With Sheets("Liste") '.................................on agit sur cette feuille uniquement
       Do While j <= .Range("A" & Rows.Count).End(xlUp).Row 'boucle sur la colonne A jusqu'à la dernière ligne
            client = .Range("A" & j) '.......................définit le nom du client en fonction de la colonne A
               Nom = .Range("B" & j) '.......................définit le nom du pdf en fonction de la colonne B
         If client <> "" And Nom <> "" Then '................si client et Nom  sont renseignés
          F1 = client '......................................définit le nom de la feuille client
          F2 = client & " Info" '............................définit le nom de la feuille info
          F3 = client & " factures" '........................définit le nom de la feuille factures

          If FeuilleExiste(F1) And FeuilleExiste(F2) And FeuilleExiste(F3) Then 'Si les 3 feuilles existent
              Sheets(F1).Select '..............................................on sélectionne la première feuille
              Sheets(Array(F1, F2, F3)).Select Replace:=False '................puis sélectionne les 3 feuilles

            sRep = ThisWorkbook.Path & "/"  '..................................répertoire du classeur
            sFilename = Nom '..................................................nom du pdf
            ActiveSheet.ExportAsFixedFormat _
               Type:=xlTypePDF, _
               Filename:=sRep & sFilename, _
               Quality:=xlQualityStandard, _
               IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=False '.....................exporte les 3 feuilles dans le pdf
          End If
               client = "": Nom = "": Sheets(1).Select
         End If
       j = j + 1 '...........................................incrémente la ligne (client suivant)
       Loop '................................................continue la boucle
     End With
End Sub

Function FeuilleExiste(Nom As String) As Boolean 'fonction pour tester la présence de la feuille
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

A défaut d'une meilleure proposition..............

Cordialement,