Sub Alina()
Dim i&, s$
  For i = Cells(Rows.Count, "E").End(xlUp).Row To 2 Step -1
    s = Cells(i, "E")
    If Len(s) Then Rows(i + 1).Resize(1 + Len(s) - Len(Replace(s, ",", ""))).Insert
  Next
End Sub

Option Explicit
 
Sub insert_rows_after_conditions()
    Dim rngCol As Range
    Dim sTmp As String
    Dim lTmp As Long
    Dim i As Long
     
    Const sKEY_PHRASE As String = "*free*"
    Const sTARGET_DELIMETR As String = ","
    Const sTARGET_COLUMN As String = "E"
    Const lROW_START As Long = 2
     
    With ActiveSheet
        Set rngCol = .Range(sTARGET_COLUMN & lROW_START & ":" & sTARGET_COLUMN & _
            .Cells(.Rows.Count, sTARGET_COLUMN).End(xlUp).Row)
        For i = rngCol.Rows.Count To 1 Step -1
            sTmp = rngCol.Rows(i).Value
            If sTmp Like sKEY_PHRASE Then
                lTmp = Len(sTmp) - Len(Replace(sTmp, sTARGET_DELIMETR, "")) + 1
                rngCol.Rows(i).Offset(1).Resize(lTmp).EntireRow.Insert xlDown
            End If
        Next i
    End With
End Sub

      Sub StrokaAfterCHILD()
      Dim i As Range
          
          For Each i In Selection
          If i = "0-3y free" Then i.Offset(1, 0).EntireRow.Insert xlDown

      Next
      End Sub