Sub mrshkei()
Dim arr, arr2, arr3, i As Long, n As Long
lr = Cells(Rows.Count, 2).End(xlUp).Row
arr = Range("B3:C" & lr)
For i = LBound(arr) To UBound(arr)
    arr2 = Split(arr(i, 2), ",")
    x = x + UBound(arr2) + 1
Next i
ReDim arr3(1 To x, 1 To 2): k = 1

For i = LBound(arr) To UBound(arr)
    arr2 = Split(arr(i, 2), ",")
    For n = LBound(arr2) To UBound(arr2)
        arr3(k, 1) = arr(i, 1)
        arr3(k, 2) = Trim(arr2(n))
        k = k + 1
    Next n
Next i
Range("E3").Resize(UBound(arr3), 2) = arr3
End Sub