Sub tt()
    r0_ = 5
    r1_ = Range("A" & Rows.Count).End(3).Row
    If r1_ < r0_ Then Exit Sub
    c1_ = ActiveCell.SpecialCells(xlLastCell).Column
    arz = Range("A" & r0_).Resize(r1_ - r0_ + 1, c1_)
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    For i = UBound(arz) To 1 Step -1
        If InStr(arz(i, 1), ",") Then
            armas = Split(arz(i, 1), ",")
            Range("A" & r0_ + i).Resize(UBound(armas)).EntireRow.Insert
            Range("A" & r0_ + i).Resize(UBound(armas), c1_) = WorksheetFunction.Index(arz, i, 0)
            Range("A" & r0_ + i - 1).Resize(UBound(armas) + 1, 1) = Application.Transpose(armas)
        End If
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
End Sub

Sub tt()
    Dim arz()
    r0_ = 5
    r1_ = Range("A" & Rows.Count).End(3).Row
    If r1_ < r0_ Then Exit Sub
    c1_ = ActiveCell.SpecialCells(xlLastCell).Column
    ReDim arz(r1_ - r0_, c1_ - 1)
    arz = Range("A" & r0_).Resize(r1_ - r0_ + 1)
    arz1 = Range("B" & r0_).Resize(r1_ - r0_ + 1, c1_)
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    For i = UBound(arz) To 1 Step -1
        If InStr(arz(i, 1), ",") Then
            armas = Split(arz(i, 1), ",")
            Range("A" & r0_ + i).Resize(UBound(armas)).EntireRow.Insert
            fff = WorksheetFunction.Index(arz1, 0, i)
            Range("B" & r0_ + i).Resize(UBound(armas), c1_ - 1) = WorksheetFunction.Index(arz1, i, 0)
            Range("A" & r0_ + i - 1).Resize(UBound(armas) + 1) = Application.Transpose(armas)
        End If
    Next i
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
End Sub

Public Sub insRow()
Dim i As Long, rowLast&, j&, k&
Dim rng1 As Range
Dim clnLast&, rowStart&
Dim arrStr

    With ThisWorkbook.ActiveSheet
        
        rowStart = 5
        rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
        clnLast = .Cells(rowStart, Columns.Count).End(xlToLeft).Column
        For i = rowLast To rowStart Step -1
          arrStr = Split(.Cells(i, 1).Value, ",")
          If UBound(arrStr) > 0 Then
              Set rng1 = .Range(.Cells(i, 2), .Cells(i, clnLast))
              
              For j = UBound(arrStr) To 1 Step -1
                  k = i + 1
                  .Rows(k & ":" & k).Insert
                  rng1.Copy Destination:=.Cells(k, 2)
                  .Cells(k, 1).Value = arrStr(j)
              Next j
              .Cells(i, 1).Value = arrStr(0)
        
          End If
        
        Next i
    End With
End Sub