Bonsoir
Une petite idée , en supposant que la liste soit en A1: Bxx et se termine par une case vide :
m = 1
n = 1
d = Cells(n, 1)
Debut:
a = Cells(n, 1)
b = Cells(n, 2)
c = Cells(n + 1, 1)
d = d & b
n = n + 1
If c = a Then GoTo Debut
Cells(m, 3) = d
d = Cells(n, 1)
m = m + 1
If Cells(n + 1, 1) = "" Then End
GoTo Debut