Macro to export word table data to excel

Since you hard code the Word table row/column, there's no need to iterate the row/columns.

I think what you want is:

Sub Extract()
    Dim wrdTbl As Table
    Dim RowCount As Long, ColCount As Long, i As Long, j As Long
    Dim NextRow As Long
    '~~> Excel Objects
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object

    '~~> Set your table
    Set wrdTbl = Selection.Tables(1)

    '~~> Create a new Excel Applicaiton
    Set oXLApp = CreateObject("Excel.Application")

    '~~> Hide Excel
    oXLApp.Visible = False

    '~~> Open the relevant Excel file
    Set oXLwb = oXLApp.Workbooks.Open("C:\Users\sogorman\Desktop\Test.xlsx")
    '~~> Work with Sheet1. Change as applicable
    Set oXLws = oXLwb.Sheets(1)
        '~~> Put your code here to export the values of the Word Table
        '~~> cell to Excel Cell. Use the .Range.Text to get the value
        '~~> of that table cell as shown above and then simply put that
        '~~> in the Excel Cell
        With oXLws
            NextRow = .Cells(.Rows.Count, "C").End(-4162).Row + 1
            .Cells(NextRow, 2).Value = wrdTbl.Cell(4, 2).Range.Text
            .Cells(NextRow, 3).Value = wrdTbl.Cell(4, 4).Range.Text
            .Cells(NextRow, 4).Value = wrdTbl.Cell(5, 2).Range.Text
            .Cells(NextRow, 5).Value = wrdTbl.Cell(5, 4).Range.Text
            .Cells(NextRow, 6).Value = wrdTbl.Cell(2, 4).Range.Text
            .Cells(NextRow, 7).Value = wrdTbl.Cell(2, 2).Range.Text
            .Cells(NextRow, 8).Value = wrdTbl.Cell(3, 2).Range.Text
        End With

    '~~> Close and save Excel File
    oXLwb.Close savechanges:=True

    '~~> Cleanup (VERY IMPROTANT)
    Set oXLws = Nothing
    Set oXLwb = Nothing
    oXLApp.Quit
    Set oXLApp = Nothing

    MsgBox "DONE"

End Sub