Split column add row

dw700d 

Run the following macro:

Sub SplitData()
    Dim r As Long
    Dim m As Long
    Dim a() As String
    Dim i As Long
    Dim n As Long
    Dim d As Double
    Application.ScreenUpdating = False
    m = Range("C" & Rows.Count).End(xlUp).Row
    For r = m To 3 Step -1
        a = Split(Range("C" & r).Value, ", ")
        n = UBound(a)
        If n > 0 Then
            d = Range("B" & r).Value / (n + 1)
            For i = n To 1 Step -1
                Range("A" & r).EntireRow.Copy
                Range("A" & r + 1).EntireRow.Insert
                Range("B" & r + 1).Value = d
                Range("C" & r + 1).Value = a(i)
            Next i
            Range("B" & r).Value = d
            Range("C" & r).Value = a(0)
        End If
    Next r
    Application.ScreenUpdating = True
End Sub