Convertir une table

Bonjour,

J'ai une table Access composée des colonnes "Code article", "Emplacement", "Quantité" et "Date".

Chaque code article peut apparaitre autant de fois qu'il y a d'emplacement/quantité différentes pour chacun d'entres eux.

Mon souhait serait de pouvoir - en un clic - obtenir une seule ligne par "Code Article" et transposer à la suite sur cette même ligne les différents emplacements et quantités en stock.

Ci-joint une illustration de mon tableau de départ et de ce que je souhaite obtenir.

En option, si quelqu'un à la méthode pour le faire sur Access je lui en serai gré

Bonsoir Iceman35, le forum

Ça devrait le faire.

Dans ton fichier joint, supprime la 1ère ligne.

Option Explicit

Sub Regrouper()
Dim a, i As Long, j As Long, n As Long, col As Byte, w
    a = Sheets("Convertir").Range("A1").CurrentRegion.Value
    col = UBound(a, 2): n = 1
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1: .Item(a(i, 1)) = VBA.Array(n, col)
                For j = 1 To col
                    a(n, j) = a(i, j)
                Next
            Else
                w = .Item(a(i, 1)): w(1) = w(1) + 3
                If UBound(a, 2) < w(1) Then
                    ReDim Preserve a(1 To UBound(a, 1), 1 To w(1))
                End If
                For j = 1 To 3
                    a(w(0), w(1) - 3 + j) = a(i, j + 1)
                Next
                .Item(a(i, 1)) = w
            End If
        Next
    End With
    If UBound(a, 2) > col Then a(1, 5) = "Empl2": a(1, 6) = "Qté2": a(1, 7) = "Date2"
    'Restitution et mise en forme en feuil1
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.Clear
        .Value = a
        If UBound(a, 2) > col + 3 Then
            With .Offset(, 4).Resize(1, 3)
                .AutoFill .Resize(, UBound(a, 2) - col)
            End With
        End If
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .Borders(xlInsideVertical).Weight = xlThin
        .BorderAround Weight:=xlThin
        With .Rows(1)
            .Font.Size = 11
            .BorderAround Weight:=xlThin
            With .Offset(, 1).Resize(, .Columns.Count - 1)
                .Interior.ColorIndex = 44
            End With
        End With
        With .Columns(1).Offset(1).Resize(.Rows.Count - 1)
            .Interior.ColorIndex = 19
        End With
        .Columns.ColumnWidth = 15
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Bonjour Klin,

Merci beaucoup pour ta réponse rapide, on ne peut pas en dire autant pour moi

Et je te confirme ça fonctionne parfaitement !