Option Explicit
Const stdata        As String = "Y17"

Public Sub SplitTable_v2()
    On Error GoTo ErrorHandler
    Dim i As Long, ir As Long, cc As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.CutCopyMode = False

    With ActiveSheet

        Dim st      As Range
        Set st = .Range(stdata)

        Dim nCol    As Long
        nCol = st.CurrentRegion.Columns.Count

        Dim Offs    As Long
        Offs = nCol + 2

        Dim rTitle  As Range
        Set rTitle = st.Resize(1, nCol)

        Dim arrData
        arrData = st.CurrentRegion.Value

        Dim c0      As Long
        c0 = st.Column

        Dim r0      As Long
        r0 = st.Row

        Dim lCol    As Long
        lCol = .Cells(r0 - 1, .Columns.Count).End(xlToLeft).Column

        For cc = st.Column + Offs To lCol Step Offs
            .Range(.Cells(r0, cc), _
                    .Cells(r0 + UBound(arrData), cc + nCol - 1)).Clear
        Next cc

        c0 = st.Column

        For i = 2 To UBound(arrData)

            If arrData(i, 2) Like "Группа *" Then

                Do
                    c0 = c0 + Offs

                    If c0 > lCol Then Exit For
                Loop Until .Cells(r0 - 1, c0).Value = "Группа"

                If c0 > lCol Then Exit For
                ir = i

            ElseIf i < UBound(arrData) Then

                Do While i < UBound(arrData) And _
                        Not arrData(i, 2) Like "Группа *"
                    i = i + 1
                Loop

                rTitle.Copy .Cells(r0, c0)

                .Cells(r0 + ir - 1, st.Column).Resize(i - ir, nCol).Copy
                .Cells(r0 + 1, c0).PasteSpecial xlPasteValuesAndNumberFormats

                .Cells(r0 + ir - 1, st.Column).Resize(i - ir, nCol).Copy
                .Cells(r0 + 1, c0).PasteSpecial xlPasteFormats

                i = i - 1
            End If

        Next i

    End With

ExitHandler:
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ExitHandler
End Sub

Option Explicit
Const stdata        As String = "AA15"

Public Sub SplitTable_v3()
    On Error GoTo ErrorHandler

    Dim i As Long, ir As Long, g As Long, C As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.CutCopyMode = False

    With ActiveSheet

        Dim st      As Range
        Set st = .Range(stdata)

        Dim nCol    As Long
        nCol = st.CurrentRegion.Columns.Count

        Dim rTitle  As Range
        Set rTitle = st.Resize(1, nCol)

        Dim arrData
        arrData = st.CurrentRegion.Value

        Dim r0      As Long
        r0 = st.Row
        '        Debug.Print r0

        Dim SrcCol  As Long
        SrcCol = st.Column

        Dim lCol    As Long
        lCol = .Cells(r0 - 1, .Columns.Count).End(xlToLeft).Column
        '        Debug.Print lCol

        Dim GroupCols() As Long
        Dim GroupCount As Long

        For C = SrcCol + 1 To lCol

            If Trim$(.Cells(r0 - 1, C).Value) = "Группа" Then
                GroupCount = GroupCount + 1
                ReDim Preserve GroupCols(1 To GroupCount)
                GroupCols(GroupCount) = C
            End If

        Next C

        If GroupCount = 0 Then GoTo ExitHandler

        Dim LastCol As Long
        LastCol = .Cells(15, .Columns.Count).End(xlToLeft).Column
        '        Debug.Print LastCol

        Dim LastRow As Long
        LastRow = r0 + UBound(arrData)
        '        Debug.Print LastRow

        .Range(.Cells(15, "AH"), .Cells(LastRow, LastCol)).Clear

        g = 0

        For i = 2 To UBound(arrData)

            If arrData(i, 2) Like "Группа *" Then
                g = g + 1
                If g > GroupCount Then Exit For
                ir = i

            ElseIf i < UBound(arrData) Then

                Do While i < UBound(arrData)
                    If arrData(i, 2) Like "Группа *" Then Exit Do

                    i = i + 1
                Loop

                rTitle.Copy
                .Cells(r0, GroupCols(g)).PasteSpecial xlPasteAll

                .Cells(r0 + ir - 1, SrcCol).Resize(i - ir, nCol).Copy

                .Cells(r0 + 1, GroupCols(g)).PasteSpecial _
                        Paste:=xlPasteValuesAndNumberFormats

                .Cells(r0 + ir - 1, SrcCol).Resize(i - ir, nCol).Copy

                .Cells(r0 + 1, GroupCols(g)).PasteSpecial _
                        Paste:=xlPasteFormats

                i = i - 1
            End If

        Next i

    End With

ExitHandler:
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox Err.Description, vbCritical
    Resume ExitHandler
End Sub