Sub Testing_1()

Dim lr As Long, i As Integer, j As Integer, ray

Application.ScreenUpdating = False

With Sheets("Sheet1")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 2 Step -1
        ray = Split(.Cells(i, 4).Value, ",")
        If UBound(ray) > 0 Then
            .Range("A" & i).Resize(, 4).Copy
            .Range("A" & i + 1).Resize(UBound(ray), 4).Insert xlShiftDown
            For j = LBound(ray) To UBound(ray)
                .Cells(i, 4).Offset(j).Value = Trim(ray(j))
            Next j
        End If
    Next i
End With
    
Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub