Sub test()
Dim lsto, t, i&, s, n&, k&, j&, id
If ActiveSheet.ListObjects("Tableau2").ListRows.Count > 0 Then Range("Tableau2").Delete
If ActiveSheet.ListObjects("Tableau1").ListRows.Count = 0 Then Exit Sub
t = ActiveSheet.ListObjects("Tableau1").DataBodyRange.Resize(, 2)
For i = 1 To UBound(t): n = n + Len(t(i, 1)) - Len(Replace(t(i, 1), " ", "")): Next
ReDim R(1 To n, 1 To 1)
For i = 1 To UBound(t)
s = Split(t(i, 1)): id = Join(Array(s(0), s(1)))
For j = 2 To UBound(s): k = k + 1: R(k, 1) = id & " " & s(j): Next
Next i
Range("Tableau2").Resize(k, 1) = R
End Sub