Option Explicit
Sub Concatenate()
Dim a, i As Long, j As Long, n As Long
Application.ScreenUpdating = False
With Sheets("Feuil1").Range("a1").CurrentRegion
a = .Value
With CreateObject("Scripting.Dictionary")
.CompareMOde = 1
For i = 1 To UBound(a, 1)
If Not .exists(a(i, 1)) Then
n = n + 1: .Item(a(i, 1)) = n
For j = 1 To 2
a(n, j) = a(i, j)
Next
Else
'a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) & vbLf & a(i, 2)
a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) & "|" & a(i, 2)
End If
Next
End With
End With
With Sheets("Feuil2").Range("a1")
.CurrentRegion.Clear
With .Resize(n, UBound(a, 2))
.Value = a
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders.Weight = 2
End With
With .CurrentRegion.Rows(1)
.Interior.ColorIndex = 43
.Font.Size = 11
End With
.Parent.Select
End With
Application.ScreenUpdating = True
End Sub