Macro création nouveau fichier suivant modele et impression

Bonjour à toutes et tous,

je travaille sur l'optimisation de la saisie de données. J'ai créé (ou modifié celles trouvées sur le net) plusieurs macros, mais là j'arrive au point où je bloque :

j'ai 3 types de fichiers,

1 Récapitulatif (RECAP contenant 1000 lignes, 1 ligne par produit),

1 fichier (FICH qui est le détail des produits du RECAP, donc il y 1000 fichiers, en PJ il est inclut dans IMPRIM)

1 à Imprimer (IMPRIM, qui contient 8 cellules à copier de chaque Fichiers)

J'ai donc besoin de votre aide pour :

avoir une macro sur RECAP qui copie les données (8 cellules) du fichier de la ligne, les colle dans le fichier IMP et... imprime

il faudrait donc un bouton au bout de chaque ligne qui modifierait le fichier IMPRIM suivant les données du fichier de la ligne

ce n'est peut-être pas très clair, alors un bon croquis vaut mieux que tous les discours :

voici la macro pour IMPRIMER (créée avec l'enregistreur) à adapter suivant la ligne où on se trouve dans RECAP :

Sub Imprimer()
Dim typetouret As Variant
Dim equipe As String, dateperception As String, cpte As String, mtrestant As String, nro As String, pm As String, numtouret As String

'' Imprimer Macro
'    Sheets(2).Select
    typetouret = Cells(2, 1).Value
    equipe = Cells(22, 12).Value
    dateperception = Cells(22, 13).Value
    cpte = Cells(22, 14).Value
    mtrestant = Cells(22, 17).Value
    nro = Cells(22, 18).Value
    pm = Cells(22, 19).Value
    numtouret = Cells(2, 6).Value
    Sheets(1).Select
    Cells(1, 6).Value = dateperception
    Cells(2, 2).Value = nro
    Cells(3, 2).Value = pm
    Cells(4, 2).Value = equipe
    Cells(5, 2).Value = cpte
    Cells(8, 4).Value = mtrestant
    Cells(8, 2).Value = numtouret
    Cells(8, 1).Value = typetouret

End Sub

je n'arrive pas à créer un bouton par ligne qui contient la macro IMPRIM en tenant compte de sa position dans le tableau RECAP.

Si vous avez une autre idée pour atteindre le résultat, je suis aussi preneur bien sûr (on est plus intelligents à plusieurs que tout seul )

MERCI

Le cerveau fume !!!

il y a une autre possibilité :

ajouter à chaque fichier (FICH) un onglet qui contient IMPRIM avec la macro,

alors j'ai trouvé cette macro qui fonctionne impec, merci à BOUBEN :

https://forum.excel-pratique.com/viewtopic.php?t=84301

mais elle ne copie pas la macro du fichier IMPRIM :

Option Explicit

Public Sub MAJ()

    Dim sFicModele As String
    Dim oWBModele As Workbook
    Dim oShModele As Worksheet
    Dim sRep As String
    Dim oFSO As FileSystemObject
    Dim oFic As File
    Dim oWBCible As Workbook
    Dim oShCible As Worksheet
    Dim iTotal As Integer 'avancement
    Dim iAvanc As Integer 'avancement
    Dim bOngletExist As Boolean 'V0.2

    sFicModele = Application.GetOpenFilename()

    If sFicModele = "Faux" Then
        Exit Sub
    End If

    sRep = ChoixDossier

    If sRep = "" Then
        Exit Sub
    End If

    'ouverture sans mise à jour les liaisons
    Set oWBModele = Workbooks.Open(sFicModele, False, True)
    Set oShModele = oWBModele.Worksheets(1)

    Set oFSO = New FileSystemObject

    iAvanc = 1
    iTotal = oFSO.GetFolder(sRep).Files.Count
    Application.ScreenUpdating = False

    For Each oFic In oFSO.GetFolder(sRep).Files

        'avancement
        modProgress.ShowProgress iAvanc, iTotal, "Traitement en cours ..."

        If UCase(Right(oFic.Name, 4)) = ".XLS" Or _
        UCase(Right(oFic.Name, 5)) = ".XLSM" Or _
        UCase(Right(oFic.Name, 5)) = ".XLSX" Then

            Application.DisplayAlerts = False 'passer le message sur les liaisons
            Set oWBCible = Workbooks.Open(oFic.Path)
            Application.DisplayAlerts = True

            'V0.2
            'Set oShCible = oWBCible.Worksheets.Add(Before:=oWBCible.Worksheets(1))
            'test si onglet déjà existant
            bOngletExist = OngletExist(oWBCible, oShModele.Name)

            If bOngletExist Then
                'onglet existant : on pointe dessus
                Set oShCible = oWBCible.Worksheets(oShModele.Name)
            Else
                'onglet inexistant : on ajoute un nouvel onglet
                Set oShCible = oWBCible.Worksheets.Add(Before:=oWBCible.Worksheets(1))
                'nom de la feuille : reprise du nom initial
                oShCible.Name = oShModele.Name
            End If
            'V0.2-fin

            oShModele.Cells.Copy
            oShCible.Range("A1").PasteSpecial xlPasteAll

            Application.CutCopyMode = False
            Set oShCible = Nothing

            Application.DisplayAlerts = False
            oWBCible.Close True
            Application.DisplayAlerts = True
            Set oWBCible = Nothing

        End If

        iAvanc = iAvanc + 1

    Next oFic

    Application.ScreenUpdating = True

    Set oFSO = Nothing
    oWBModele.Close False
    Set oWBModele = Nothing
    Set oShModele = Nothing

    MsgBox "Traitement terminé !", vbExclamation

End Sub

Public Function ChoixDossier() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
    End With

End Function

est-ce possible de la modifier pour qu'elle copie aussi la macro IMPRIM ?

Merci

j'en profite pour saluer tout le travail d'aide des contributeurs, j'ai passé du temps à chercher et trouvé beaucoup de solutions ici, soit complètes, soit à adapter. Bravo à vous

ti up !

quelqu'un aurait une réponse ?

merci