Option Explicit
Sub Doublon()
Dim i As Long, j As Integer
Dim d As Object
Dim c As Variant
Set d = CreateObject("scripting.dictionary")
For i = 2 To [a65000].End(xlUp).Row
If Not d.exists(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) Then
For j = 1 To 7
d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) = d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) & Cells(i, j).Value & ":"
Next j
d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) = d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) & ":" & Cells(i, 8).Value
Else: d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) = d(Cells(i, 1).Value & Cells(i, 2).Value & Cells(i, 3).Value & Cells(i, 4).Value & Cells(i, 5).Value & Cells(i, 6).Value & Cells(i, 7).Value) & " | " & Cells(i, 8).Value
End If
Next i
Range(Cells(2, 1), Cells([a56000].End(xlUp).Row, 9)).ClearContents
i = 2
For Each c In d.Keys
Cells(i, 1).Resize(, 9) = Split(d(c), ":")
i = i + 1
Next c
For Each c In d.Keys
Debug.Print c & " - " & d(c)
Next c
End Sub