Sub Concatener()
Dim Ligne As Long, I As Long, J As Byte, Mémoire As String, Mot As String
For I = 1 To Range("A65536").End(xlUp).Row + 1
If Left(Cells(I, 1), 8) <> Mémoire Then
Mémoire = Left(Cells(I, 1), 8)
If Ligne > 0 Then Cells(Ligne, 2) = Mot
Ligne = Ligne + 1
Mot = ""
Mot = Cells(I, 1)
Else
J = Len(Cells(I, 1))
While Mid$(Cells(I, 1), J, 1) <> "_"
J = J - 1
Wend
Mot = Mot & " / " & Mid$(Cells(I, 1), J + 1, Len(Cells(I, 1)) - J + 1)
End If
Next I
End Sub