Plusieurs lignes pour un enregistrement à renseigner en colonnes

[Matagami]

Bonjour.

Suite à une extraction de données, j'ai plusieurs lignes pour un même identifiant. Pour travailler correctement, j'aurais besoin que pour chaque identifiant, les infos soient collectées en colonnes.

Voir l'exemple en pièce jointe.

Merci d'avance de votre aide.

 

[klin89]

Re : Plusieurs lignes pour un enregistrement à renseigner en colonnes

Bonsoir Matagami, le forum 🙂

A tester, restitution en Feuil2.

Option Explicit

Sub Regrouper()
Dim a, i As Long, j As Long, n As Long, col As Byte, w
    a = Sheets("Feuil1").Range("A2").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) + 2
                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 2
                    a(w(0), w(1) - 2 + j) = a(i, j + 4)
                Next
                .Item(a(i, 1)) = w
            End If
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Cells(1).Resize(n, UBound(a, 2))
        .CurrentRegion.Clear
        .Value = a
        If UBound(a, 2) > 6 Then
            With .Offset(, 4).Resize(1, 1)
                .AutoFill .Resize(, UBound(a, 2) - 4)
            End With
        End If
        .Font.Name = "calibri"
        .Font.Size = 10
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders(xlInsideVertical).Weight = xlThin
        .BorderAround Weight:=xlThin
        With .Rows(1)
            .Font.Size = 11
            .Interior.ColorIndex = 44
            .BorderAround Weight:=xlThin
        End With
        .Columns.ColumnWidth = 15
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[Matagami]

Re : Plusieurs lignes pour un enregistrement à renseigner en colonnes

Bonjour.

Merci !

Je vais voir si qqu'un peut m'aider à appliquer cette solution... j'envisageais plutôt une formule... ou un TCD...