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
Bookmarks