Sub ТекстоПоСтрокам()
    Dim arr As Variant
    arr = GetArr()
    
    If Not IsArray(arr) Then
        MsgBox "Выделите диапазон.", vbInformation
        Exit Sub
    End If

    Dim y As Long
    Dim x As Long
    Dim h As Long
    Dim n As Long
    x = UBound(arr, 2)
    For y = 1 To UBound(arr, 1)
        n = n + 1 + Len(arr(y, x)) - Len(Replace(arr(y, x), ",", ""))
    Next
    
    Dim orr As Variant
    ReDim orr(1 To n, 1 To x)
'    For h = 1 To x
'        orr(1, h) = arr(1, h)
'    Next
    
    Dim brr As Variant
    Dim v As Variant
    n = 0
    For y = 1 To UBound(arr, 1)
        brr = Split(arr(y, x), ",")
        For Each v In brr
            n = n + 1
            For h = 1 To x - 1
                orr(n, h) = arr(y, h)
            Next
            orr(n, x) = Trim(v)
        Next
    Next
        
    OutArr orr
End Sub

Sub OutArr(arr As Variant)
    With Workbooks.Add(1)
        .Sheets(1).Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
        .Saved = True
    End With
End Sub

Function GetArr() As Variant
    Dim arr As Variant
    arr = Intersect(Selection, ActiveSheet.UsedRange)
    GetArr = arr
End Function

Sub SplitNames()
m1 = Sheets("Начальные данные").Range("A2:C10").Value
n = 1
For i = LBound(m1) + 1 To UBound(m1)
    A = Split(m1(i, 3), ", ")
    n = n + UBound(A) + 1
Next i
ReDim m2(1 To n + 1, 1 To 3)
n = 1
For i = LBound(m1) To UBound(m1)
    A = Split(m1(i, 3), ", ")
    For j = LBound(A) To UBound(A)
        If A(j) <> "" Then
            For k = 1 To UBound(m1, 2)
                m2(n, k) = m1(i, k)
            Next k
            m2(n, UBound(m1, 2)) = A(j)
            n = n + 1
        End If
    Next j
Next
Sheets("Итог").Range("A2:C" & UBound(m2)).Value = m2
End Sub