How to copy first and last row of each table of Word file to an Excel sheet?

Question

There are around 150 tables in my Word file. Each table has six rows and two columns.

I need to copy the first and last row values from each table to an Excel sheet.

The first row will have my table id and last row data is Pass/Fail.

Answer 1

In general, you should try to post the code that you tried so far so we can help you debug and get to the final answer:

1. Summarize the problem
2. Describe what you’ve tried
3. Show some code When appropriate, share the minimum amount of code others need to reproduce your problem (also called a minimum, reproducible example)

But, I'll try to give you some code to get going.

If it helps you, please consider to mark it as the correct answer :)

Please try the following code:

Sub extract_word_table_values_to_excel()

    Dim word_app As Object, temp_doc As Object, word_doc As Object

    'Set word_app = CreateObject("Word.Application")
    ActiveSheet.Calculate

    word_path = Range("Word_path")
    'Place your word doc path here in the named range on the sheet

    temp = Split(word_path, "\")
    word_name = temp(UBound(temp))

    Set word_doc = GetObject(word_path)
    Set word_app = word_doc.Application

    word_app.Visible = True
    word_doc.Activate

    excel_row = 1

    On Error Resume Next

    Dim word_table As Word.Table 'Or As variant

    For Each word_table In word_doc.Tables
        Err.Clear
        For i = 1 To word_table.Rows.Count Step word_table.Rows.Count - 1
            'Step count minus 1 means only first and last row are looped
            For j = 1 To word_table.Columns.Count
                part = word_table.Rows(i).Cells(j).Range.Text
                part = Left(part, Len(part) - 1)
                part = Replace(part, vbNewLine, "")
                'MsgBox part
                Sheet2.Cells(excel_row, j).Value = part
            Next j
            excel_row = excel_row + 1
        Next i
        excel_row = excel_row + 1 'Leave row between tables
    Next word_table

    MsgBox "done"

    word_doc.Save
    'word_app.Quit
    Set word_doc = Nothing
    Set word_app = Nothing       

End Sub

Please leave a comment if you have a question.