Sub Regrouper()
Dim tablo, i&, j%, n&, t()
With ActiveSheet.UsedRange
If .Count = 1 Then Exit Sub 'sécurité
tablo = .Resize(, .Columns.Count + 1)
End With
ReDim t(Application.CountA([B:B].Resize(, Columns.Count - 1)), 1)
For i = 2 To UBound(tablo)
j = 2
While tablo(i, j) <> ""
t(n, 0) = tablo(i, 1)
t(n, 1) = tablo(i, j)
j = j + 1
n = n + 1
Wend
Next
If n Then [A2].Resize(n, 2) = t
[C:C].Resize(, Columns.Count - 2).ClearContents
End Sub