Copier coller de Tableau + mise en page + Création d'un pdf

Bonjour,

Je poste aujourd'hui car je suis a la recherche d'une macro qui dans un premier temps me permettrait de copier une partie d'un tableau structuré dans le Classeur1 qui a pour nom (Stock2022VBA) pour le coller dans un Classeur2 (StockTemp).

Ensuite j'edite a la main les options de mes clients dans le nouveau Classeur2 et dans un second temps la macro devrait pouvoir renvoyer les options dans le tableau original grâce a un bouton ou quelque chose du genre.

Et enfin 3eme temps, aprés avoir renvoyé les infos ils faudrait pouvoir ajouter des pages du modèle (ModèleDossierVBA) au classeur 2 selon les options qui on été choisie par le client (Exp : Si le client a l'option Bovins lait, il faut ajouter la page de facture "Bovins lait" etc)

J'ai déjà établi une partie du code je suis preneur de toutes correction/aide ou solution

En détails, voila le fonctionnement :
1- Saisie texte pour sélectionnez les dossiers des comptables à traiter (Recherche par saisie du "Code.Collab", toutes les lignes d'information lié au code collab appelé devront être extraites lors de l'opération) Si code collab 2 est appelé il faudrait tout les dossiers lié au code collab 2 etc.
2- Extraction des « dossiers » du document vers un nouveau Classeur Excel (Qui sera nommé : StockTemp)
3- ? Quelles sont les options du client ? Exp: Bovin lait ou viande etc
4- Retour des informations « D’options client » dans le document original (Nommé : Stock2022VBA.xlsx)
5- Génère une copie temporaire du document « ModeleDossierVBA.xlsx»
6- Suppression des pages inutiles (Suppression de toutes les pages "modèles" de facture inutile)
7- Création du pdf depuis le fichier temporaire
8- Suppression du fichier temporaire"

(J'utilise un UserForm dans Sub main pour l'Interface utilisateur)

    Sub main()
        Dim reponse As String
        reponse = InputBox("Quels dossiers de collaborateur cherchez vous ? (Veuillez entrer le CodeCollab a extraite)", "Extraction Dossier Client")
        If reponse = "" Then
            Call MsgBox("Je n'ai pas compris votre demande veuillez reessayer", , "Erreur")
        Else    
            Call MsgBox("Vous avez demande les dossiers du code collab " & reponse & "", , "Dossier à extraire")
            RechercheDossiersCollab
        End If
    End Sub

    Sub RechercheDossiersCollab() 
        Const Limit As Integer
        For Each c In Range("Code_Collab") 
            If c.Value = Limit Then 
                ExportCollab
            End If 
        Next c 
    End Sub

    Sub ExportCollab()
        //A Faire//
    End Sub
9stock2022vba.xlsx (16.34 Ko)

Merci a vous pour l'aide
Cordialement,
Ao.

Bonjour aoplis,

1) dans les fichiers donnés, aucun avec un USF ou du code (pas de .xlsm)

2) Vous pouvez utiliser l'enregistreur de macros pour avoir votre code

image

Après avoir cliqué sur ce bouton, effectuez les opérations indiquées et vous obtiendrez du code

Que nous pourrons alors optimiser, si vous le souhaitez

a+

Bonjour Bruno,

Merci pour ta réponse.

ça parait peu être bête mais je pensais honnêtement que l'enregistreur de macro était catastrophique comme beaucoup d'autre outils du même genre.

Je me suis mis au travail et voila ce que j'ai actuellement :

1-La boite de dialogue fonctionne

2-La fonction d'extraction tourne a merveille

3-Il me manque le retour des informations saisie depuis le nouveau fichier vers le fichier d'origine. Y a t'il une solution pour l’échange d'information entre deux excel ? Sachent que mon document original fait environ 3000lignes sur 26colonne et que j'ai besoin de saisir les information seulement depuis le morceau de document extrait + Toutes les informations sont contenue dans un tableau nommé CONSOLIDATION qui ce divise en différentes partie en utilisant le CodeCollab.

4-La moitié du tableau est déjà complété, il manque seulement les données des 16 dernières colonnes, ce sont les informations a faire remonter dans le fichier original

5-Ainsi que la création des pdf qui en découle. (Qui ne sera pas trop dur a faire)

Au plaisir de vous lire, Ao.

Rebonjour,
J'ai quasiment fini la partie export en pdf du modèle de facture.
Mon seul problème est que quand j'essaye de faire remonter une info d'un tableau avec un filtre appliqué je me retrouve avec des données qui aurait du être filtré voila le code :

Et je me retrouve en sortie avec un firchier qui s'enregistre au nom de "2022_" au lieu d'inclure le nom du client.

J'ai tester de remplacer

NomClient = Range("F2")
Par 
NomClient = ActiveSheet.ListObjects("CONSOLIDATION").ListColumns("Nom_Client").DataBodyRange
Il me faudrait pour tout dire, aprés avoir appliqué le filtre, sélectionner les données filtrés pour les exploiter
 Public NumDossier As String

    Sub ChatBoxNumDossier()

    NumDossier = InputBox("Quels dossiers cherchez vous ? (Veuillez entrer le numero de dossiers a extraite)", "Extraction Dossier Client")

            If NumDossier = "" Then
                Call MsgBox("Je n'ai pas compris votre demande veuillez reessayer", , "Erreur")

            Else
                Call MsgBox("Vous avez demande le dossier numero " & NumDossier & "", , "Dossier à extraire")
                CreationModelePdf
            End If
    End Sub

    Sub CreationModelePdf()

    Dim CheminModele As String
    CheminModele = "\\SRV\ModelePDF.xlsx"

                ActiveSheet.ListObjects("CONSOLIDATION").Range.AutoFilter Field:=2, Criteria1:=NumDossier
                NomClient = Range("F2")
                DateCloture = Range("G2")
                BovinsViande = Range("H2")
                BovinsLait = Range("I2")

           Workbooks.Open Filename:=CheminModele

        Range("D9:G9").Select
        ActiveCell.FormulaR1C1 = NomClient

        Range("D12:G12").Select
        ActiveCell.FormulaR1C1 = NumDossier

        Range("G22:H22").Select
        ActiveCell.FormulaR1C1 = DateCloture

        Application.DisplayAlerts = False

                    If BovinsViande = "" Then
                Sheets("Bovins Viandes").Select
                ActiveWindow.SelectedSheets.Delete
            Else
            End If

                    If BovinsLait = "" Then
                Sheets("Bovins lait").Select
                ActiveWindow.SelectedSheets.Delete
            Else
            End If

Application.DisplayAlerts = True
            SavePDF

    End Sub

  Sub SavePDF()

        myPath = "\\SRV\"
        Filename = Year(Date) & "_" & NomClient

    Sheets.Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myPath & Filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Merci a vous pour l'aide

Ao

Rechercher des sujets similaires à "copier coller tableau mise page creation pdf"