Try

Sub test()
    Dim a, i As Long, ii As Long, w, maxCol As Long
    Dim e, n As Long, x, txt As String
    With Range("a2").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                txt = a(i, 1) & ";;" & a(i, 2)
                If Not .exists(txt) Then
                    ReDim w(1 To UBound(a, 2))
                    For ii = 1 To UBound(a, 2)
                        w(ii) = a(i, ii)
                    Next
                    .Item(txt) = w
                Else
                    w = .Item(txt)
                    ReDim Preserve w(1 To UBound(w) + 7)
                    For ii = 3 To UBound(a, 2)
                        w(UBound(w) - 10 + ii) = a(i, ii)
                    Next
                    .Item(txt) = w
                    maxCol = Application.Max(maxCol, UBound(w))
                End If
            Next
            For Each e In .keys
                w = .Item(e)
                If UBound(w) < maxCol Then
                    ReDim Preserve w(1 To maxCol)
                    .Item(e) = w
                End If
            Next
            x = .items: n = .Count
        End With
        With .Range("n2")
            .CurrentRegion.Offset(1).ClearContents
            .Resize(n, maxCol).Value = _
            Application.Transpose(Application.Transpose(x))
        End With
    End With
End Sub