How to separate cell values and insert into new rows

this works based on your test_multiple_cells.xlsx
run this macro

Function NthWord(Words As String, N As Integer) As String
   'Extracts the Nth word from the string Words
   Dim WordArray     As Variant
   WordArray = Split(Words)
   If UBound(WordArray) < N - 1 Then
      NthWord = "#N/A"
   Else
      NthWord = WordArray(N - 1)
   End If
End Function


Sub Loop_Example()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long

    With ActiveSheet

        Firstrow = 2
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        For Lrow = Lastrow To Firstrow Step -1

            With .Cells(Lrow, "B")

                If Not IsError(.Value) Then

                    If .Value Like "*, *" Then
                        x = Range("B" & Lrow)
                        Range("B" & Lrow).Value = Replace(x, ", ", Chr(32))
                    End If
                    
                    If .Value Like "* *" Then
                        x = Range("B" & Lrow)
                        Range("B" & Lrow).Value = Replace(x, " ", Chr(32))
                    End If
                    
                    b = Chr(10)
                    c = " "
                    Range("B:B").Replace What:=b, Replacement:=c, LookAt:=xlPart, SearchOrder _
                        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                
                End If

            End With

        Next Lrow
        
        For Lrow = Lastrow To Firstrow Step -1

            With .Cells(Lrow, "B")

                If Not IsError(.Value) Then

                    x = Range("B" & Lrow)
 
                    Ln = Len(x) - Len(Replace(x, " ", ""))
                    If Ln > 0 Then
                        Range(Range("B" & Lrow + 1), Range("B" & Lrow + Ln)).EntireRow.Insert (2)
                    Else:
                    End If
                    For i = Lrow + 1 To Lrow + Ln
                    x = Range("B" & Lrow)
                        Range("A" & i).FillDown
                        Range("C" & i).FillDown
                        theword = NthWord(Range("B" & Lrow).Value, 2)
                        Range("B" & i).Value = theword
                        Range("B" & Lrow).Value = Replace(x, " " & theword, "")
                    Next
                    End If

            End With

        Next Lrow
        
       

    End With

End Sub

Thanks guys,
Both work well, but I like Scott's since it fixes it on the same sheet. But both were awesome. Much thanks!!