Boucle Copier coller jusqu’à cellule vide

Bonjour,

Étant débutant sur vba, j'ai vraiment besoin d'aide sur ce coup-là. Je me casse la tête depuis un moment pour trouver le bon code vba, mais sans succès....

J'ai adapté le code ci-dessous afin de pouvoir faire une exportation en pdf et dans un répertoire choisi.

Sub Export_1Fiche_PDF()
Dim Chemin As String, NomFichier As String
   NomFichier = Range("B2").Value & " (" & Format(Date, "dd mmm-yy") & ").pdf"
    With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With

  Sheets("Fiche agent").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & NomFichier, _
                                          Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                          IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

Les informations lisibles sur l'exportation sont appelées (sur l'onglet "fiche agent") depuis un menu déroulant permettant de sélectionner un nom (issue d'une base sur l'onglet "Gest_Eff") qui met à jour l'ensemble de la fiche.

Dans l'état si je souhaite (et c'est un réel besoin) exporter l'ensemble des fiches de l'ensemble du personnel il est nécessaire que je face l'opération de sélection pour chacune des personnes pour réaliser l'exportation de l'ensemble des fiches.

Je souhaite pouvoir exécuter l'exportation de l'ensemble des fiche à l'aide d'une boucle ... toutefois mon niveau en Vba n'est pas suffisant pour trouver seul la solution.

Le schéma que je souhaite mettre en action est le suivant :

Sub Export_ToutesFiches_PDF()

1.    Sélectionner le répertoire d’accueil des fiches à exporter
2.    Activation et déroulement de la boucle
    a.    Prendre le 1er nom de la liste nominative de l’onglet "Gest_Eff" en  cellule A3
    b.    Copier cette valeur en B2 dans l’onglet "Fiche agent" et valider pour charger les données
    c.    Exporter la fiche courante en reprenant tout ou partie du code ci-dessus
    d.    Répéter l’opération avec la valeur de l’onglet "Gest_Eff" immédiatement en dessous (A3 -> A4 -> A5 -> etc)
    e.    Arrêter la boucle dès la 1ère valeur vide rencontrée dans la colonne A de l’onglet "Gest_Eff"
End Sub

Je vous remercie par avance de l'aide que vous pourrez m'apporter.

Salut,

Un petit fichier anonymisé ne serait pas de refus car pour pouvoir tester une éventuelle proposition sans c'est compliqué

Pour ma part j'ai l'impression que tu cherches à faire du publipostage en fait... Connais-tu cette possibilité ou est-ce du chinois pour toi ?

J'ai quand même testé quelque chose :

Sub Export_ToutesFiches_PDF()
'
' Export_ToutesFiches_PDF Macro

Dim Chemin As String, NomFichier As String

'Sélection du repertoire d'accueil des fiches à exporter
    With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)

    i = 3
    Do While Sheets(1).Range("A" & i).Value <> ""
    'Déroulement de la procédure
    Sheets(2).Range("B2").Value = Sheets(1).Range("A" & i).Value
    NomFichier = Sheets(2).Range("B2").Value & " (" & Format(Date, "dd mmm-yy") & ").pdf"
    Sheets("Fiche agent").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & NomFichier, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    i = i + 1
    Loop

    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With

'
End Sub

Girodo

Grand merci Girodo

Moyennant l'adaptation du code aux noms des feuilles le code fonctionne à merveille.

Pour ma part je ne suis pas resté inactif et j'ai adapté le code suivant

Sub Export_TTFiche2_PDF()
Dim Chemin As String, NomFichier As String

'--------------- détermine le repertoire de destination (début)
    With Application.FileDialog(msoFileDialogFolderPicker)
    If .Show = -1 Then    ' Clic sur Ok
     Chemin = .SelectedItems(1)
    Else
      ' Clic sur Annuler
     Exit Sub
    End If
  End With
'--------------- détermine le repertoire de destination (fin)
'--------------- Mise en place de la boucle (début)
    Celfin = Sheets("Gest_Eff.").Range("A956").End(xlUp).Row 'récupère le nombre de cellule non vide

    For LIGNE = 3 To Celfin
    NomFichier = Sheets("Gest_Eff.").Range("A" & LIGNE).Value & " (" & Format(Date, "dd mmm-yy") & ").pdf"

    Range("B2").Value = Sheets("Gest_Eff.").Range("A" & LIGNE).Value
    Application.Goto Reference:="print"
    Sheets("Fiche agent").ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "\" & NomFichier, _
                                          Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                                          IgnorePrintAreas:=False, OpenAfterPublish:=False
  Next LIGNE

End Sub

Le code de Girodo va s'interrompre dès que le déroulement rencontre une cellule vide (c'est d’ailleurs ce qui était demandé)

Le mien va déterminer en calculant le nombre de cellules non vides entre A3 et A956 afin de déterminer le nombre de fois que la boucle doit s'exécuter ... il ne interrompt donc pas sur une cellule vide mais crée une fiche vide.

Dans les 2 cas il semble judicieux d'ajouter avant le démarrage de la boucle une commande qui va trier en alpha les données de l'onglet "Gest_Eff" afin d'éliminer les cellules vides intermédiaires.

Toutefois le code de Girodo semble plus fluide ... et c'est donc celui-ci que je vais utiliser

Merci beaucoup

Salut,

J'ai relu vite fait ton code, à mon avis il aurait posé problème dans le cas où tu lance la procédure et que tu utilises le bouton annuler au moment de sélectionner le répertoire de destination.

Bon courage pour la suite

Girodo,

Merci beaucoup pour cette précieuse aide.