Public Sub textToColumns()
Set ARange = Range("A:A")
Set BRange = Range("B:B")
Set CRange = Range("C:C")
Set DRange = Range("D:D")
Dim arr() As String
lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set out = Worksheets.Add
out.Name = "out"
outRow = 2
For i = 2 To lr
arr = Split(ARange(i), ",")
For j = 0 To UBound(arr)
out.Cells(outRow, 1) = Trim(arr(j))
out.Cells(outRow, 2) = BRange(i)
out.Cells(outRow, 3) = CRange(i)
out.Cells(outRow, 4) = DRange(i)
outRow = outRow + 1
Next j
Next i
End Sub
I didn't do the headers or deal properly with the output sheet but you can see basically what's going on.