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