Sub Eclater()
Dim c As Range, a$(), n%, s, i%, b$()
Application.ScreenUpdating = False
Rows("4:" & Rows.Count).ClearContents 'RAZ
For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
If CStr(c) <> "" Then
Erase a: n = 0
s = Split(c(2), vbLf)
For i = 0 To UBound(s)
If Trim(s(i)) <> "" Then
ReDim Preserve a(n) 'base 0
a(n) = s(i)
n = n + 1
End If
Next i
ReDim b(4) 'base 0
Select Case n
Case Is > 6: MsgBox "Trop de lignes en " & c(2).Address(0, 0) & " !"
Case 6: b(0) = a(0) & ", " & a(1): b(1) = a(2): b(2) = a(3): b(3) = a(4): b(4) = a(5)
Case 5
If Val(a(3)) = Int(Val(a(3))) And Len(a(3)) > 2 Then
For i = 0 To 4: b(i) = a(i): Next i
Else
b(0) = a(0) & ", " & a(1): b(1) = a(2): b(2) = a(3): b(4) = a(4)
End If
Case 4: b(0) = a(0): b(1) = a(1): b(3) = a(2): b(4) = a(3)
Case 3: b(0) = a(0): b(1) = a(1): b(4) = a(2)
Case 2: b(0) = a(0): b(4) = a(1)
Case 1: b(0) = a(0)
Case 0: b(0) = "TBA"
End Select
'---restitution---
c(4).Resize(5) = Application.Transpose(b)
End If
Next c
Columns.AutoFit 'ajustement largeurs
End Sub