Creation d'une macro

Question

J'aurai besoin de votre aide, mais de votre temps surtout... Je souhaite réaliser une macro, enfin j'ai pas le niveau pour le faire, c'est pour ce que je demande votre aide.... Dans le fichier excel joint, le premier tableau est le tableau original(ce n'est qu'une petite partie d'un gros tableau). Le second tableau est le résultat que je souhaite avoir. Pour l'exemple je n'ai pris qu'un rapport, un rapport peut avoir plusieurs plant, plusieurs groupes d'équipement et plusieurs service. Chaque plant est multiplié par les groupes d'équipements, et chaque groupe d'équipement est multiplié par un service. Les couleurs et flèches ne sont la que pour expliquer le fonctionnement. Dans mon tableau final, je voudrais pouvoir détaillé tout ceci. C'est a dire tout mettre sur une ligne, chaque plant avec une fois les différents services et les différents groupes d'équipements. Je pense qu'il faudrait d'abord insérer le nombre de ligne qu'il faut pour chaque plant suivant le rapport, dans l'exemple, 14 (3groupes d'équipements * 5 services - 1(vu qu'une ligne existe déjà)) Puis copier la ligne du 1er plant dans les lignes qu'on vient d'insérer Ensuite copier tous les services et les coller en decallant pour chaque groupes d'équipement et après coller les groupes d'équipement. Les données de chaque ligne du tableau original pour un rapport correspond a chaque plant, sauf pour le groupes d'équipements et de services donc. Bien sur l'ordre de la macro peut changer, c'est juste mon avis (de debutant). Voila, j'espere que vous avez compris ce que je veux faire, si une personne a le temps de se pencher dessus ca sera sympa Merci d'avance Le lien du fichier ...

Nad-Dan · Answer

Vois le fichier joint dans lequel tu as deux feuilles. Première feuille où sont tes données à recopier Deuxième feuille indentique à la première pour ce qui est des titres. Sur ta première feuille, un bouton sur lequel il te suffit de cliquer pour transférer les données en feuille 2. Fichier Amicalement Dan PS: si ton pb est terminé, n'oublie pas de mettre RESOLU sur le fil. Explications ici --&gt; https://forum.excel-pratique.com/viewtopic.php?t=13 Merci de ta participation...

cousinhub · Answer

Zut, un peu à la bourre (Salut, Dan...) Mais, bon, comme je l'ai fait, je le mets quand même... Dans la feuille 2, ce que tu avais mis.. Et dans la feuille 3, ce que tu sembles vouloir.. https://www.excel-pratique.com/~files/doc2/Limbouille_v1.xls Bonne journée...

Nad-Dan · Answer

Re, Salut cousinhub. Bon petite précision pour notre ami, dans le code que je t'ai proposé, on suppose que qu'il y a une données dans les colonnes J et K. Si tu n'as pas de données dans ces cellules rien n'est copié bien sûr. Si ce n'est pas bon, je peux adapter le code mais plus facile d'utiliser celui de cousinhub qui est déjà fait ..... Amicalement Dan...

cousinhub · Answer

Re-,

remplace par ce code :

Sub Transfert()
Dim Services As Object, Equip As Object
Dim Cel As Range
Dim DerLig As Long, DerLig2 As Long, I As Long
Dim DerCol As Byte, J As Byte, K As Byte
Dim FBase As Worksheet, FDest As Worksheet
Dim Tmp1, Tmp2
Set Services = CreateObject("Scripting.Dictionary")
Set Equip = CreateObject("Scripting.Dictionary")
Set FBase = Worksheets("Sheet1")
Set FDest = Worksheets("Sheet3")

FDest.Cells.Clear
With FBase
    DerCol = .[IV1].End(xlToLeft).Column
    DerLig = .[A65000].End(xlUp).Row
    For Each Cel In .Range("K2:K" & DerLig)
        If Cel.Value <> "" Then Equip.Item(Cel.Value) = Cel.Value
    Next Cel
    For Each Cel In .Range("J2:J" & DerLig)
        If Cel.Value <> "" Then Services.Item(Cel.Value) = Cel.Value
    Next Cel
    Tmp1 = Application.Transpose(Equip.Items)
    Tmp2 = Application.Transpose(Services.Items)
    .Range(.Cells(1, 1), .Cells(1, DerCol)).Copy FDest.Range("A1")
    For I = 2 To DerLig
        a = .Range(.Cells(I, 1), .Cells(I, DerCol))
            For J = LBound(Tmp2) To UBound(Tmp2)
                a(1, 10) = Tmp2(J, 1)
                For K = LBound(Tmp1) To UBound(Tmp1)
                    a(1, 11) = Tmp1(K, 1)
                    DerLig2 = FDest.[A65000].End(xlUp).Row + 1
                    FDest.Cells(DerLig2, 1).Resize(1, DerCol) = a
                Next K
            Next J
    Next I
End With
With FDest.Range("A1:AB" & DerLig2).Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
With FDest
    .Columns("C:C").NumberFormat = "00"
    .Range("AB:AB,D:D").NumberFormat = "0000000"
End With
End Sub

cousinhub · Answer

Bon, déjà, ce n'est plus du tout la même chose que la demande initiale.... Pour la première partie, pas trop difficile, quoique.. pour la deuxième, un peu plus Là où ça se gâte, c'est qu'il faudra faire des tests en pagaille... pour un résultat aléatoire, qui risque de générer plus d'erreurs, qui en terme de temps de contrôle, risquent de prendre plus de temps que de gain de temps... Si j'ai le temps, je vais peut-être regarder.... Mais je ne confirme rien......