Sub Resultat()
Dim i As Long
Dim j As Integer
Dim iLastRow As Long
Dim Kod1 As Integer
Dim Kod2
Dim Razmer As Integer
  iLastRow = [A5].End(xlDown).Row
     For i = iLastRow To 6 Step -1
       If InStr(1, Cells(i, 2), ",") <> 0 Then
         Kod1 = Cells(i, 1)
         Kod2 = Split(Cells(i, 2), ",")
         Razmer = Cells(i, 3)
         For j = 0 To UBound(Kod2)
           Rows(i + j).Insert
           Cells(i + j, 1) = Kod1
           Cells(i + j, 2) = Kod2(j)
           Cells(i + j, 3) = Razmer
         Next
           Rows(i + j).Delete
       End If
     Next
End Sub