Sub SplitData()
Application.DisplayAlerts = False
Dim str As Variant
Dim i As Long, j As Long, cnt As Long
i = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
cnt = 2
For j = 2 To i
str = Split(Range("B" & j).Value, ",")
Range("D" & cnt).Resize(UBound(str) - LBound(str) + 1).Value = Application.Transpose(str)
Range("C" & cnt).Resize(UBound(str) - LBound(str) + 1).Value = Range("A" & j)
cnt = Sheet1.Cells(Rows.Count, "D").End(xlUp).Row + 1
Next
Application.DisplayAlerts = True
End Sub