Edit cell contents in table in Word, based on other cell contents

I have an Excel file containing a very large table, in which I have a macro that copies the table into a Word file.

I want the macro to check the top left cell of each page in the Word file and - if it's empty - populate it with the contents of the last populated cell above it (i.e. on the previous page) with " cont'd" added to the end.
The result should look like the below (ignore the three rows at the top of the second page - they are in the header):

I produced the below. I'm aware that my approach is flawed as if you have a single entry spanning multiple pages, then working from the beginning will result in subsequent pages having extra " cont'd" added, so it may make more sense to work back from the end.

' Get the Word table
Set wordTable = objDoc.Tables(1)

' Loop through the table cells
For Each cell In wordTable.Range.Cells
    ' Check if it's the top-left cell of a new page
    If cell.Range.Information(3) = 1 Then ' wdFirstCellOnPage
        currentPage = cell.Range.Information(2) ' wdActiveEndAdjustedPageNumber
        ' Check if the cell is blank and not on the first page
        If IsEmpty(cell.Value) And currentPage > 1 Then
            ' Get the corresponding cell above
            Set previousCell = wordTable.cell(cell.RowIndex - 1, cell.ColumnIndex)
            ' Copy the contents of the cell above and add " cont'd"
            previousCell.Range.Copy
            cell.Range.Paste
            cell.Range.InsertAfter " cont'd"
        End If
    End If
Next cell

OK, you can test my code by placing the cursor in your previousCell, and watching if this is what you want to be.

If it is, you just have to adjust to the configuration you need.

The GetTopleftCellPage, previousCell, valueRef are the point.

Sub VBA_Macro_to_edit_cell_contents_in_table_in_Word_based_on_other_cell_contents()

    Dim objDoc As Word.Document, cell As Word.cell, previousCell As Word.cell
    Dim valueRef As String, wordTable As Word.Table, ur As UndoRecord
    Set ur = Word.Application.UndoRecord
    ur.StartCustomRecord "VBA_Macro_to_edit_cell_contents_in_table_in_Word_based_on_other_cell_contents"
    
    Set objDoc = ActiveDocument
        
    Rem Test my code by placing the cursor in the *previousCell*
        If Not Selection.Information(wdWithInTable) Then 'just for test
            MsgBox "must placing the cursor in a cell to try!", vbCritical
            Exit Sub
        End If
    Set previousCell = Selection.Cells(1) 'just for test
    previousCell.Range.Text = "01-007" ''just for test
    valueRef = Replace(previousCell.Range.Text, Chr(13) & Chr(7), "")
    
    ' Get the Word table
    'Set wordTable = objDoc.Tables(1) 'YOU GOT ONLY ONE TABLE in a document??
    Set wordTable = previousCell.Range.Tables(1)
        
    Set cell = GetTopleftCellPage(previousCell)
    
    Do Until cell Is Nothing
        If VBA.Len(cell.Range.Text) = 2 Then 'Chr(13) & Chr(7)
            cell.Range.Text = valueRef + " cont'd"
            
            Rem just for watch in testing
            cell.Range.Select
        
        End If
        Set cell = GetTopleftCellPage(cell)
    Loop
    
    ur.EndCustomRecord
    
    MsgBox "done!", vbInformation
    
'    ' Loop through the table cells
'    For Each cell In wordTable.Range.Cells
'        ' Check if it's the top-left cell of a new page
'        If cell.Range.Information(3) = 1 Then ' wdFirstCellOnPage
'            currentPage = cell.Range.Information(2) ' wdActiveEndAdjustedPageNumber
'            ' Check if the cell is blank and not on the first page
'            If IsEmpty(cell.Value) And currentPage > 1 Then
'                ' Get the corresponding cell above
'                Set previousCell = wordTable.cell(cell.RowIndex - 1, cell.ColumnIndex)
'                ' Copy the contents of the cell above and add " cont'd"
'                previousCell.Range.Copy
'                cell.Range.Paste
'                cell.Range.InsertAfter " cont'd"
'            End If
'        End If
'    Next cell

End Sub
Property Get GetTopleftCellPage(ByVal cell As cell) As Word.cell
    Dim r As Long, rng As Range, tb As Word.Table ', d As Document
    Dim firstVisibleLine As Long, currentPage As Long
    Dim firstCellOnPage As cell
    'Set d = ActiveDocument
    Set tb = cell.Range.Tables(1)
    r = cell.RowIndex
    Set rng = cell.Range
    currentPage = rng.Information(wdActiveEndPageNumber)
    Do While currentPage = rng.Information(wdActiveEndPageNumber)
        r = r + 1
        Set rng = tb.cell(r, 1).Range
        If r >= tb.rows.Count Then
            Exit Property
        End If
    Loop
    Set GetTopleftCellPage = rng.Cells(1)
End Property

The result demo:

follow the previous row

When I look more closely at your screenshot, it looks like you just want to give the value of the previous column to the next column. If that's the case, simply run these lines:

dim rowCell as long
rowCell= previousCell.row+1
if rowCell <=tb.rows.count then
   Set cell = tb.cells(rowCell,previousCell.ColumnIndex)
   cell.Range.Text = valueRef + " cont'd"
end if

OR

Or, you can get the cell at the top of each page by GetTopleftCellPage and then get the corresponding cell in the row before it. All these needs should be already in the code I gave.

This will scan down the first column of the table looking for cases where the cell is the first on a page and is empty:

Sub Tester()

    Dim tbl As Table, col As Column, c As Cell, i As Long, pgNumStart, pgNumEnd
    Dim rng As Range, currPage, lastText, txt, newPage As Boolean
    
    Set tbl = ActiveDocument.Tables(1)
    Set col = tbl.Columns(1) 'only looking in the first column of the table
    
    currPage = 0
    For Each c In col.Cells
        Set rng = c.Range.s
        rng.Collapse wdCollapseStart
        pgNumStart = rng.Information(3)   'cell begins on this page
        'pgNumEnd = c.Range.Information(3) 'cell ends on this page
        
        
        newPage = (pgNumStart > 1) And (pgNumStart <> currPage) 'on a new page?
        If newPage Then currPage = pgNumStart                   'update current page
        
        txt = CellText(c)
        
        If Len(txt) = 0 Then 'cell is empty?
            If newPage And Len(lastText) > 0 Then
                c.Range.Text = lastText & vbLf & "(cont)"
            End If
        Else
            lastText = txt
        End If
    Next c

End Sub

'cell text, minus end-of-cell marker
Function CellText(c As Cell)
    CellText = Replace(c.Range.Text, Chr(13) & Chr(7), "")
End Function