Split string cell into multi rows but keep original row

Question

I have a macro that splits a string (list of names) using a space as the delimiter and creates a new row for each name while keeping all data the same in other columns. However I need to maintain the original row and I can't work out how to do this.

My VBA code is below and works but I can't maintain the original row. Any suggestions will be greatly appreciated.

Sub Split_name() 
    Dim iRow As Long
    Dim lastrow As Long
    Dim ws As Worksheet
    Dim iSplit() As String
    Dim iIndex As Long
    Dim iSize As Long


Const ANALYSIS_ROW As String = "C"
Const DATA_START_ROW As Long = 2

    Set ws = ActiveSheet 
    With ws
        lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
    End With


    For iRow = lastrow To DATA_START_ROW Step -1
        iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2)
        iSize = UBound(iSplit) - LBound(iSplit) + 1
        If iSize = 1 Then GoTo Continue
        ws.Rows(iRow).Copy
        ws.Rows(iRow).Resize(iSize - 1).Insert
        For iIndex = LBound(iSplit) To UBound(iSplit)
            ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
        Next iIndex
Continue:
    Next iRow
End Sub

Answer 1

Simply offset the Insert. Also, you can speed this up by placing the data in one go

For iRow = lastrow To DATA_START_ROW Step -1
    iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2)
    iSize = UBound(iSplit) - LBound(iSplit) + 1
    If iSize > 1 Then
        With ws.Rows(iRow + 1).Resize(iSize)
            .Insert
            .Columns(ANALYSIS_ROW).Value2 = Application.Transpose(iSplit)
        End With
    End If
Next iRow

_{Untested, so may require a few tweeks}