Split table on overflow and copy header row to new table

Question

I'm tring to split a table if the table overflows the slide. I found some code that I modified slightly.

But when I try to add a row on the new table to copy the header from the original table I get an error.

If I add the line:

```    oTableShape.Table.Rows.Add BeforeRow:=1```

after the final next in the CopyToNewTable routine, I get an error at:

 ``` oSourceShape.Table.cell(RowIndex + I - 1, J).Shape.textFrame.textRange.Copy```

which is a couple of lines above. The error is:

```Method 'Copy' of object ' Textrange' failed.```

If I delete it, the add befor, it works fine.

Code follows.

Thanks in advance

Function GetRowOverFlowIndex(oShape As Shape, oPres As Presentation) As Long
Dim Index As Long
Dim sngSldHeight As Single
Dim sngCurrHeight As Single

sngSldHeight = txDrawAreaTop + txDrawAreaHeight ' oPres.PageSetup.SlideHeight
'Get the top position of the shape on the slide
      sngCurrHeight = oShape.Top
 
For Index = 1 To oShape.Table.Rows.Count

          'Check if the current height exceeds that of the slide height
   
      If sngCurrHeight + oShape.Table.Rows(Index).Height > sngSldHeight Then
        
      'We have found the row at which the table moves off the slide.
       
      GetRowOverFlowIndex = Index
       
      Exit Function
   
      Else
        
      'Increment the current height

             
      sngCurrHeight = sngCurrHeight + oShape.Table.Rows(Index).Height

          End If

      Next
End Function

'' Copy that row onwards to a new slide
Sub CopyToNewTable(oSlide As slide, oSourceShape As Shape, RowIndex As Long)
Dim oTableShape As Shape
Dim I As Long
Dim J As Long

Set oTableShape = oSlide.Shapes.AddTable(oSourceShape.Table.Rows.Count - RowIndex + 1, _
      oSourceShape.Table.Columns.Count, _
      oSourceShape.left, _
      oSourceShape.Top, _
      oSourceShape.Width)

For I = 1 To oTableShape.Table.Rows.Count
   For J = 1 To oTableShape.Table.Columns.Count
    
      'Copy the text from the cell.
      oSourceShape.Table.cell(RowIndex + I - 1, J).Shape.textFrame.textRange.Copy
       
      'Paste it into the new location.
      oTableShape.Table.cell(I, J).Shape.textFrame.textRange.Paste
   Next
    
   oTableShape.Table.Rows(I).Height = oSourceShape.Table.Rows(RowIndex + I - 1).Height
Next
   
   oTableShape.Table.Rows.Add BeforeRow:=1

End Sub

'' Delete the copied rows from the source table from the main routine.
'' Let us bring it altogether into this routine.
   
Sub SplitTable()
Dim RowIndex As Long
Dim oShp As Shape
Dim oSld As slide
Dim I As Long

Set oShp = ActiveWindow.Selection.ShapeRange(1)

'Check if the selected shape is a table.
If Not oShp.HasTable Then
    MsgBox "This is not a table.", vbExclamation
    Exit Sub
End If

'Get the row at which table moves off the slide
RowIndex = GetRowOverFlowIndex(oShp, ActivePresentation)

'If no rows are out of slide, just get out otherwise process it
If RowIndex > 0 Then
   'Add a new slide for the a new table
   Set oSld = ActivePresentation.Slides.Add(oShp.Parent.SlideIndex + 1, oShp.Parent.Layout)
   'Now copy the rows to the new table.
   Call CopyToNewTable(oSld, oShp, RowIndex)

'Delete the rows from the original table
   For I = oShp.Table.Rows.Count To RowIndex Step -1
      oShp.Table.Rows(I).Delete
   Next
End If
End Sub

Answer 1

I followed @timwilliams advice and re-wrote the routine to duplicate the slide and delete the unnecessary rows on each slide's tables. Thanks Tim for the steerirng!