VBA to Split and fill

[NeoSez]

I am trying to figure out how to separate column D into separate cells in the same column just below the current row.
So, 001 Street will have a new row just below this one.
002 Street will have a new row just below this one.
003 Street will have a new row just below this one.
etcera
It should copy the preceding information with it.

tiles	12x24	10	001 street 002 street 003 street 008 street 112 street 222 street 234 street 456 street 666 street 777 street
ladders	30'	2	898 street 929 street
doors	35x88	3	555 street 666 street 777 street

The new chart will look something like this:
I hope this all makes sense.

tiles	12x24	10	001 street
tiles	12x24	10	002 street
tiles	12x24	10	003 street

 

[NeoSez]

You're welcome. Glad we could help.

One more question:
Can I insert a blank row after each row has been converted to it's new rows?
So using this example, after all the tiles have been completed, insert blank row, then it will continue with the next row which is the Ladders etc.

tiles	12x24	10	001 street
tiles	12x24	10	002 street
tiles	12x24	10	003 street

 

[Alex Blakenburg]

If you means after each row has been split then replace the redim with the line in green and add the line in blue:

    ReDim arrOut(1 To maxLines + UBound(arrSrc), 1 To UBound(arrSrc, 2))    ' Added UBound(arrSrc) to allow for blank rows
  
    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, splitColNo), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            rowOut = rowOut + 1
            For iCol = 1 To UBound(arrSrc, 2)
                arrOut(rowOut, iCol) = arrSrc(i, iCol)          ' should skip column 19 but it will get overwritten anyway
            Next iCol
            arrOut(rowOut, splitColNo) = splitCell(j)
        Next j
        rowOut = rowOut + 1                                     ' Insert Blank Row
    Next i

 

[NeoSez]

If you means after each row has been split then replace the redim with the line in green and add the line in blue:

    ReDim arrOut(1 To maxLines + UBound(arrSrc), 1 To UBound(arrSrc, 2))    ' Added UBound(arrSrc) to allow for blank rows
 
    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, splitColNo), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            rowOut = rowOut + 1
            For iCol = 1 To UBound(arrSrc, 2)
                arrOut(rowOut, iCol) = arrSrc(i, iCol)          ' should skip column 19 but it will get overwritten anyway
            Next iCol
            arrOut(rowOut, splitColNo) = splitCell(j)
        Next j
        rowOut = rowOut + 1                                     ' Insert Blank Row
    Next i

Perfection! A thousand thanks Alex.