Sub CopyTablesToExcel()
Dim xlApp As Object
Dim xlBook As Object
Dim oTable As Table
Dim NextRow As Long
Dim oCell As Range
Const strWorkBookName As String = "C:\Path\Story - Excel output.xlsx"
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err Then
        Set xlApp = CreateObject("Excel.Application")
    End If
    On Error GoTo 0
    Set xlBook = xlApp.Workbooks.Open(Filename:=strWorkBookName)
    xlApp.Visible = True
    For Each oTable In ActiveDocument.Tables
        NextRow = xlBook.Sheets(1).Range("A" & xlBook.Sheets(1).Rows.Count).End(-4162).Row + 1
        Set oCell = oTable.Rows(1).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("A" & NextRow) = oCell.Text
        Set oCell = oTable.Rows(2).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("B" & NextRow) = oCell.Text
        Set oCell = oTable.Rows(3).Cells(2).Range
        oCell.End = oCell.End - 1
        xlBook.Sheets(1).Range("C" & NextRow) = oCell.Text
        xlBook.Save
    Next oTable
    Set xlApp = Nothing
    Set xlBook = Nothing
    Set oCell = Nothing
    Set oTable = Nothing
lbl_Exit:
    Exit Sub
End Sub