Regroupement données sur une feuille

SIERREUR(RECHERCHEV(Résultats!A2;'AM1'!A$2:E$6;5;0);"")

Option Explicit

Sub Regroupement()
Dim a, i As Long, j As Long, txt As String, n As Long
    With Sheets(1).Range("a1").CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 1 To UBound(a, 1)
                txt = a(i, 1)
                If Not .exists(txt) Then
                    n = n + 1
                    .Item(txt) = n
                    For j = 1 To UBound(a, 2)
                        a(n, j) = a(i, j)
                    Next
                Else
                    For j = 7 To 8
                        a(.Item(txt), j) = a(i, j)
                    Next
                End If
            Next
        End With
        Application.ScreenUpdating = False
        With Sheets(2).Cells(1).Resize(n, UBound(a, 2))
            .CurrentRegion.Clear
            .Value = a
            .Cells(1, .Columns.Count + 1).Value = "Solde total"
            .Columns(.Columns.Count + 1).Offset(1).Resize(n - 1).Formula = "=rc[-4]+rc[-2]"
            With .CurrentRegion
                .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 = 38
                    .BorderAround Weight:=xlThin
                End With
            End With
        End With
        Application.ScreenUpdating = True
    End With
End Sub