Passage de lignes en

Bonjour,

J'ai un petit soucis sur excel. J'ai une suite comme ci dessous, sauf qu'il y a bien plus que deux type d'entrées (il y en a plus de 300)....

POMME | A | | |

POMME | | B | |

POIRE | | B | |

POIRE | A | | C |

Et j'aimerais résumer ceci sous cette forme de manière automatique pour ne pas à faire ca manuellement sur les 300 entrées.

POMME | A | B | |

POIRE | A | B | C |

En gros ca reviendrait à supprimer les doublons de la première colonne, mais en fusionnant les autres colonnes par rapport à la première colonne.

J'espère que vous m'avez compris et que c'est clair !

Merci

Yrieix

Bonjour,

Une piste avec un dictionnaire. Les noms se trouvent en colonne A de la feuille "Feuil1" à partir de A1 (Pomme, Poire, etc...) et les résultats sont inscris en feuille "Feuil2" dans la colonne A pour les noms et les autres colonnes pour les valeur des noms (A, B, C, etc...) A adapter bien sûr :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim Dico As Object
    Dim Cle As Variant
    Dim I As Integer
    Dim J As Integer

    Set Dico = CreateObject("Scripting.Dictionary")

    'défini la plage des noms est en colonne A de la feuille "Feuil1" à partir de A1
    With Worksheets("Feuil1"): Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With

    'parcour la plage et stocke les valeurs des clés en les concaténant séparées par un point-virgule
    For Each Cel In Plage

        Dico(Cel.Value) = Dico(Cel.Value) & ";" & Cel.Offset(, 1).Value

    Next Cel

    'parcour la collection de clés du dictionnaire
    For Each Cle In Dico.Keys

        'inscrit les noms (nom de chaque clé) en colonne A de la feuille "Feuil2" à partir de A1
        I = I + 1
        Worksheets("Feuil2").Cells(I, 1).Value = Cle

        'puis dans chaque colonne les valeurs de la clé en cours
        For J = 0 To UBound(Split(Dico(Cle), ";"))

            Worksheets("Feuil2").Cells(I, J + 2).Value = Split(Dico(Cle), ";")(J)

        Next J

    Next Cle

End Sub

Bonjour,

Sub Macro1()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim sh1LastR As Long, sh1LastC As Integer
Dim sh2LastR As Long, sh2LastC As Integer
Dim I As Long, y As Integer, z As Integer, nb As Integer, n As Integer

Set sh1 = Worksheets("Feuil1")
Set sh2 = Worksheets("Feuil2")
sh2.Activate

sh1LastR = sh1.Cells(Rows.Count, 1).End(xlUp).Row

On Error Resume Next
ActiveWorkbook.Names("Extract").Delete
Range("Liste").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True

sh2LastR = sh2.Cells(Rows.Count, 1).End(xlUp).Row

For I = 2 To sh2LastR
   nb = Application.CountIf([Liste], Range("A" & I))
   For y = 1 To nb
     n = Evaluate("SMALL(IF(Liste=" & Range("A" & I).Address & ",ROW(Liste))," & y & ")")
     sh1LastC = sh1.Cells(n, Columns.Count).End(xlToLeft).Column
        For z = 2 To sh1LastC
          sh2LastC = sh2.Cells(I, Columns.Count).End(xlToLeft).Column + 1
          If Not sh1.Cells(n, z) = "" Then Cells(I, sh2LastC) = sh1.Cells(n, z)
        Next
   Next
Next
End Sub

j'oubliais...

Liste est une plage nommée en référence à:`

=DECALER(Feuil1!$A$1;0;0;NBVAL(Feuil1!$A:$A);1)

voici le fichier exemple:

Oh top ! Ca a m'air de fonctionner ! Merci énormément !