Hi All,

I have found a lovely bit of code to export my word table data to an excel spreadsheet. I've modified a bit to suit the job.

This is to pull all the info off a particular form and place it in my excel spreadsheet, what i need it to do is auto look for the next free row in excel and place the data there, currently I have it written in the code to place the info in row 3 of my excel table, clearly this will be a problem when i run the VB on the next form as it will overwrite my previous data.

The Word table data selections will not change, and neither will the excel table columns, I just need each form put into the next row of the excel table

Any help greatly appreciated

Here is the code I am workin with


Sub Extract()
    Dim wrdTbl As Table
    Dim RowCount As Long, ColCount As Long, i As Long, j As Long

    '~~> Excel Objects
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object

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

    '~~> Get the word table Row and Column Counts
    ColCount = wrdTbl.Columns.Count
    RowCount = wrdTbl.Rows.Count

    '~~> 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)

    '~~> Loop through each row of the table
    For i = 1 To RowCount
        '~~> Loop through each cell of the row
        For j = 1 To ColCount
            '~~> This gives you the cell contents
          
            '~~> 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
                .Cells(3, 2).Value = wrdTbl.Cell(4, 2).Range.Text
                .Cells(3, 3).Value = wrdTbl.Cell(4, 4).Range.Text
                .Cells(3, 4).Value = wrdTbl.Cell(5, 2).Range.Text
                .Cells(3, 5).Value = wrdTbl.Cell(5, 4).Range.Text
                .Cells(3, 6).Value = wrdTbl.Cell(2, 4).Range.Text
                .Cells(3, 7).Value = wrdTbl.Cell(2, 2).Range.Text
                .Cells(3, 8).Value = wrdTbl.Cell(3, 2).Range.Text
                            End With
        Next
    Next

    '~~> 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