Sub u_74()
    Application.ScreenUpdating = False
    a = Range("a5").End(xlDown).Row
    For Each b In Range("am5:ap" & a)
        c = b.Value
        If c <> "" Then
            d = c & ","
            e = Len(d)
            f = Replace(d, ",", "")
            g = Len(f)
            h = e - g
            For i = 1 To h
                j = b.Row
                o = b.Column
                k = InStr(d, ",")
                l = Left(d, k - 1)
                m = l * 3 + 3
                n = l * 3 + 5
                p = Cells(Rows.Count, "a").End(xlUp).Row + 1
                r = Application.Max(p, a + 2)
                Range("a" & j & ":ap" & j).Copy Range("a" & r)
                Range("a" & r & ":ap" & r).ClearContents
                Range("a" & j & ":e" & j).Copy Range("a" & r)
                Range(Cells(j, m), Cells(j, n)).Copy Cells(r, m)
                Range("aj" & j & ":al" & j).Copy Range("aj" & r)
                Cells(r, o) = i
                Range("aq" & r) = Cells(3, o).Value
                Range("ar" & r) = i
                Range("aq" & r & ":ar" & r).Interior.Color = 65535
                d = Mid(d, k + 1, e)
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub

    s = 3   'строка шапки таблицы
    t = 5   'верхняя строка таблицы