Sub test()
Dim a, i As Long, j As Byte, n As Long, txt As String
Application.ScreenUpdating = False
'La feuille à traiter en 1ère position dans le classeur
'Les données à partir de A1
a = Sheets(1).Range("a1").CurrentRegion.Value
'Avec en-têtes
n = 1
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 2 To UBound(a, 1)
'Détermine la clé sur les 2 premiéres colonnes
txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
If Not .exists(txt) Then
n = n + 1
For j = 1 To UBound(a, 2)
a(n, j) = a(i, j)
Next
.Item(txt) = n
Else
a(.Item(txt), 6) = a(.Item(txt), 6) & _
" " & a(i, 6)
End If
Next
End With
'Création d'une nouvelle feuille et restitution
With Sheets.Add.Cells(1)
.CurrentRegion.Clear
.Resize(n, UBound(a, 2)).Value = a
With .CurrentRegion
.Font.Name = "calibri"
.Font.Size = 10
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Rows.RowHeight = 19
With .Rows(1)
.Interior.ColorIndex = 42
.BorderAround Weight:=xlThin
End With
.Columns.AutoFit
End With
.Parent.Activate
End With
Application.ScreenUpdating = True
End Sub