Dim SplitText

'iterate through all the rows in the sheet
For i = 1 To i = 2000

'take one cell at a time
cell_value = ThisWorkbook.ActiveSheet.Cells(i, 1).Value

'Split cell contents
wrdArray() = Split(cell_value, vbLf)
For j = 0 To j = wrdArray().Len
    Var = wrdArray()(0)
    Next j

    wrdArray().Resize(UBound(SplitText) + 1).Value = Application.Transpose(SplitText)
    counter = counter + 1
Next Item