Données sur plusieurs lignes => à mettre sur une seule ligne

Bonjour,

J'ai un fichier excel regroupant des commandes. Une personne peut commander plusieurs produits. Lorsque c'est le cas j'aimerais pouvoir mettre les coordonnées de la personne et tous ses produits commandés avec la quantités sur une ligne au lieu d'avoir ces infos en colonne.

Je mets un fichier en pce jointe avec la donnée de base dans l'onglet 1 et le résultat recherché dans l'onglet 2.

Un grand merci d'avance pour vos solutions

Salut MatSalamandre,

une solution VBA en attendant les spécialistes du Power Query...
Un double-clic en 'BDD' démarre la macro qui affiche les résultats en 'Extract'

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%, iCol%, iStep%, sData$
'
'Application.ScreenUpdating = False
Cancel = True
'
Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Sort _
    key1:=Range("A2"), order1:=xlAscending, _
    key2:=Range("B2"), order2:=xlAscending, _
    key3:=Range("C2"), order3:=xlAscending, _
    Orientation:=xlTopToBottom, Header:=xlYes
tTab = Range("A2:D" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value
'
With Worksheets("Extract")
    iStep = 1
    .Cells.Delete
    sData = tTab(1, 1) & " " & tTab(1, 2)
    .[A1].Resize(1, 2) = Array("NOM", "Prénom")
    For x = 1 To UBound(tTab, 1)
        If sData <> tTab(x, 1) & " " & tTab(x, 2) Then
            sData = tTab(x, 1) & " " & tTab(x, 2)
            iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & iRow).Resize(1, 2).Value = Array(tTab(x - 1, 1), tTab(x - 1, 2))
            iCol = 1
            For y = iStep To x - 1
                iCol = iCol + 2
                .Cells(iRow, iCol).Resize(1, 2) = Array(tTab(y, 3), tTab(y, 4))
                If .Cells(1, iCol) = "" Then .Cells(1, iCol).Resize(1, 2) = Array("Art " & (iCol - 1) / 2, "Qté " & (iCol - 1) / 2)
            Next
            iStep = x
        End If
    Next
    iCol = .UsedRange.Columns.Count
    .[A1].CurrentRegion.Borders.LineStyle = xlContinuous
    .[A1].CurrentRegion.BorderAround Weight:=xlMedium
    .Range("A1").Resize(1, 2).Interior.Color = RGB(255, 190, 0)
    .Range("C1").Resize(1, iCol - 2).Interior.Color = RGB(190, 190, 190)
    .Columns(1).Resize(, iCol).AutoFit
    .Columns(3).Resize(, iCol - 2).HorizontalAlignment = xlHAlignCenter
    For x = 3 To iCol - 2 Step 4
        .Cells(1, x).Resize(.UsedRange.Rows.Count, 2).Interior.Color = RGB(225, 225, 225)
    Next
    .Activate
End With
'
End Sub


A+

Rechercher des sujets similaires à "donnees lignes mettre seule ligne"