Copying text from last row of multiple tables of different lengths

[jrooney7]

Hello all,

I have a word document (*.dotm) that will have a random number of tables, some of which will have a first row containing the word "Worksheet" - e.g. "Firearm Worksheet", "Bullet Worksheet", etc. The code below is intended to loop through the tables in the document and if it finds one with the word "Worksheet" in the first row, it copies the text in the last row and pastes it to a destination cell in the last table of the document. However, the code as written copies based where the cursor is to begin with. If the cursor is in a table that is not the longest (there is some other table that contains more rows), the code is pulling text based on the length of that table, so it's not the last row. But if I put the cursor in the longest table in the document, it seems to be copying the last row correctly. I'm thinking it's a problem with my NumberOfRowsInCurrentTable setup. Ideally, the code should work regardless of which table the cursor is in, or even if the cursor is not in a table - I don't want the end-user having to figure out which is the longest table. Here is my code:

Sub Results()
'
' Results Macro
'
'
    Application.ScreenUpdating = False

    Dim LastTable As Integer
       LastTable = ActiveDocument.Range.Tables.Count
    Dim currentTableIndex As Integer
       currentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
    Dim NumberOfRowsInCurrentTable As Integer
       NumberOfRowsInCurrentTable = ActiveDocument.Range.Tables(currentTableIndex).Rows.Count
    
    Dim t As Table
    
    For Each t In ActiveDocument.Tables
        t.Cell(1, 1).Range.Select
        Selection.Find.Execute FindText:="Worksheet"
        If Selection.Find.Found = True Then
            t.Cell(NumberOfRowsInCurrentTable, 1).Range.Select
            Selection.Range.Copy
            ' this section is for when the destination cell in the Results Table is empty
            If Len(ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Text) = 3 Then
                ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Select
                Selection.EndKey Unit:=wdLine
                Selection.PasteSpecial DataType:=wdPasteText
                ' this section is for when the destination cell in the Results Table already contains text
                ElseIf Len(ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Text) > 3 Then
                ActiveDocument.Tables(LastTable).Tables(2).Cell(1, 2).Range.Select
                Selection.EndKey Unit:=wdLine
                Selection.TypeParagraph
                Selection.TypeParagraph
                Selection.PasteSpecial DataType:=wdPasteText
            End If
        End If
    Next
    
    Application.ScreenUpdating = True

End Sub

Any help is appreciated!