Microsoft 365 Dupliquer lignes en fonction du nombre de données entre "/" dans une cellule

Sub test()
Dim dl&, t, rng As Range
For dl = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1
t = Split(Cells(dl, "F"), "/")
Set rng = Cells(dl, "A").Resize(, 5)
x = UBound(t) - 1
Rows(dl).Resize(x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(dl, "F").Resize(x + 1) = Application.Transpose(t)
Cells(dl, "A").Resize(x + 1, 5).Value = rng.Value
Next
End Sub

Sub test_II()
Dim dl&, t, rng As Range
For dl = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1
t = Split(Cells(dl, "F"), "/")
Set rng = Cells(dl, "A").Resize(, 5)
x = UBound(t)
Rows(dl).Resize(x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(dl, "F").Resize(x + 1) = Application.Transpose(t)
Cells(dl, "A").Resize(x + 1, 5).Value = rng.Value
Next
End Sub

Sub test_III()
Dim dl&, t, rng As Range
Application.ScreenUpdating = False
For dl = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1
t = Split(Cells(dl, "F"), "/")
Set rng = Cells(dl, "A").Resize(, 5)
x = UBound(t)
Rows(dl).Resize(x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(dl, "F").Resize(x + 1) = Application.Transpose(t)
Cells(dl, "F").Resize(x + 1) = Application.Trim(Cells(dl, "F").Resize(x + 1))
Cells(dl, "F").Columns.AutoFit
Cells(dl, "A").Resize(x + 1, 5).Value = rng.Value
Next
nettoyage
End Sub
Sub nettoyage()
Columns("F:F").Replace What:=Chr(10), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
Columns("F:F").Replace What:=Chr(13), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
Columns("F:F").Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
Cells.RowHeight = 15
End Sub