Transposer plusieurs valeurs en fonction d'une valeur

Bonjour,

J'ai une colonne contenant des codes et une autres contenant de la donnée relative au code. Chaque code peut avoir plusieurs données donc on peut avoir plusieurs lignes avec le même code en 1ère colonne. Chaque code peut avoir un max de 6 données

J'essaye de transposer ainsi les 6 données (max) pour chacun des codes mais j'ai quelques soucis..

Auriez vous des idées? J'ai joint un excel au post.

Merci beaucoup pour votre aide!

Salut Theoba,

voici ton fichier...

Un double-clic démarre la macro.

Petit détail : j'ai cru comprendre qu'il ne fallait retenir que 6 données max par code, ce qui est fait ici. Je prends les 6 premières données rencontrées sans autre critère que le nombre. Si divers critères interviennent dans le choix des données, il faudra forcément adapter...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData, tExtract()
'
Cancel = True
Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=Range("A1"), order1:=xlAscending, Orientation:=xlTopToBottom
tData = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row + 1)
With Worksheets("Result")
    iRow = .Range("A" & Rows.Count).End(xlUp).Row
    If iRow > 1 Then .Range("A2:B" & iRow).ClearContents
End With
For x = 1 To UBound(tData, 1)
    ReDim tExtract(1, 7)
    iIdx = 0
    tExtract(0, 0) = tData(x, 1)
    For y = x To UBound(tData, 1)
        If tData(y, 1) = tExtract(0, 0) Then
            If iIdx < 6 Then
                iIdx = iIdx + 1
                tExtract(0, iIdx) = tData(y, 2)
            End If
        Else
            x = y - 1
            With Worksheets("Result")
                iRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A2").Offset(iRow - 1, 0).Resize(1, 7).Value = tExtract
            End With
            Exit For
        End If
    Next
Next
Worksheets("Result").Activate
'
End Sub

A+

Bonjour theoba, le forum,

je te retourne ton fichier modifié :

* à l'ouverture du fichier, tu es sur la feuille "Result" : y'a qu'les entêtes de la ligne 1

* va sur la feuille "Data" ; fais Ctrl e ➯ travail effectué !

Alt F11 pour voir le code VBA, puis revenir sur Excel

si besoin, tu peux demander une adaptation.

merci de me dire si ça te convient.

dhany

Bonjour,

Merci beaucoup pour votre aide! c'est très apprécié!

Bonne journée

merci pour ton retour ! bonne journée à toi aussi !

dhany