I think this will do what you want.
Sub test()
Dim SourceRange As Range, DestinationRange As Range
Dim i As Long, maxRow As Long, cellParts As Variant, splitSize As Long
Set SourceRange = Range("A1")
Set DestinationRange = Range("k1")
DestinationRange.EntireColumn.ClearContents
With SourceRange
With Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 6)
Set SourceRange = .Cells
Set DestinationRange = DestinationRange.Resize(.Rows.Count, 6)
End With
End With
With DestinationRange
.EntireColumn.ClearContents
.Value = SourceRange.Value
maxRow = .Rows.Count
End With
i = 3
Do
With DestinationRange.Rows(i)
cellParts = Split(CStr(.Cells(1, 3).Value), ", ")
splitSize = UBound(cellParts)
If splitSize < 1 Then
cellParts = Split(CStr(.Cells(1, 5).Value), ", ")
splitSize = UBound(cellParts)
If splitSize < 1 Then
i = i + 1
Else
.Offset(1, 0).Resize(splitSize, .Columns.Count).Insert
.Resize(splitSize + 1, .Columns.Count).FillDown
.Cells(1, 5).Resize(splitSize + 1, 1).Value = Application.Transpose(cellParts)
maxRow = maxRow + splitSize
End If
Else
.Offset(1, 0).Resize(splitSize, .Columns.Count).Insert
.Resize(splitSize + 1, .Columns.Count).FillDown
.Cells(1, 3).Resize(splitSize + 1, 1).Value = Application.Transpose(cellParts)
maxRow = maxRow + splitSize
End If
End With
Loop Until maxRow < i
End Sub