This is working good for me. Kind of slow. 1000 rows 2:02
Sub SplitTableEndOfPage()
Dim n As Integer
Dim k As Integer
Dim i As Integer
Dim tblStartPage As Long
Dim oTable As Table
Dim oTableRange As Range
Dim oRow As Row
Dim firstrow As Range
123
n = ActiveDocument.Tables.Count
k = 0
Set firstrow = ActiveDocument.Tables(1).Rows(1).Range
firstrow.Copy
For i = 1 To n
Set oTable = ActiveDocument.Tables(i + k)
If (oTable.Rows.first.Range.Information(3)) <> (oTable.Rows.Last.Range.Information(3)) Then
Set oTableRange = oTable.Range
oTableRange.Collapse 1
tblStartPage = oTableRange.Information(1)
For Each oRow In oTable.Rows
With oRow.Range
If .Information(3) <> tblStartPage Then
k = k + 1
.PasteAndFormat (11)
oTable.Rows(oRow.Index - 1).Select
Selection.SplitTable
tblStartPage = .Information(3)
.InsertBefore ("Table continued from previous page.")
Selection.InsertBreak Type:=wdPageBreak
.InsertBefore ("Table continued on next page.")
End If
End With
Next
End If
Next i
t = ActiveDocument.Tables.Count
If t <> n Then GoTo 123 _
Else: GoTo 321
321
End Sub