Split table on page breaks and add header row to each new part

table_split_w_headers.bas

Sub tableSplitWithHeaders()
    'https://stackoverflow.com/questions/8668311/current-row-in-vba-word
    'https://www.tek-tips.com/viewthread.cfm?qid=1610014
    'https://stackoverflow.com/questions/37999841/how-can-i-determine-the-page-number-of-a-table-in-ms-word-macro
    'https://learn.microsoft.com/en-us/office/vba/api/word.selection.insertbreak
    
    Const TITLE_CONTINUE As String = "Продолжение таблицы"
    Const TITLE_END As String = "Окончание таблицы"

    Dim t As Table, t2 As Table, r As row
    Dim pTableName As Paragraph, pContinueName As Paragraph
    Dim tableRange As Range, continueRange As Range
    Dim startPage As Long, rowPage As Long
'    If Selection.Tables.Count <> 1 Then
'    If Selection.Information(wdStartOfRangeRowNumber) = -1 Then
    If Not Selection.Information(wdWithInTable) Then
        Debug.Print "Select a table"
        Exit Sub
    End If
    Set t = Selection.Tables(1)
    Do
        Set tableRange = t.Range
        tableRange.Collapse wdCollapseStart 'table start position
        startPage = tableRange.Information(wdActiveEndPageNumber)
        'Find table row on the next page and split table before this point
        Set t2 = Nothing
        For Each r In t.Rows
            'wdActiveEndAdjustedPageNumber учитывает ручную нумерацию страниц
            rowPage = r.Range.Information(wdActiveEndAdjustedPageNumber)
            If rowPage <> startPage Then
    '            Debug.Print r.Index
                Set t2 = t.Split(r)
                Exit For
            End If
        Next r
        'All of the rows are on the same page, stop process
        If t2 Is Nothing Then
            If Not continueRange Is Nothing Then
                'Update table title on the last page
                continueRange.Text = TITLE_END
            End If
            Exit Do
        End If
        
        'Copy header row to the new table
        t.Rows(1).Select
        Selection.Copy
        t2.Rows(1).Select
        Selection.PasteAndFormat wdFormatOriginalFormatting

        'Copy style from original table title to new part title
        Set pTableName = tableRange.Paragraphs.First.Previous
        Set pContinueName = t2.Range.Paragraphs.First.Previous
        pContinueName.Style = pTableName.Style

        'Set title text for new table part
        Set continueRange = pContinueName.Range
        continueRange.Collapse wdCollapseStart
        continueRange.Text = TITLE_CONTINUE

        'Insert page break before new table part title (if needed)
        If continueRange.Information(wdActiveEndAdjustedPageNumber) = startPage Then
            continueRange.Collapse wdCollapseStart
            continueRange.InsertBreak
            pContinueName.Previous(2).Range.Delete 'remove auto-inserted empty paragraph
        End If
        
        Set t = t2
    Loop
End Sub