VBA - Excel import word tables | Help

[borism25]

Hi! I have a few "problems" with VBA and excel/word so if someone can help me with this I will be very grateful. I get file with over 40 tables inside docx (word), mainly I am Desginer and need to transfer that tables inside Indesign but it's much easier to handle tables from excel rater than from word. So right now I acchive this.

Word VBA to extract all tables inside 1 word file, but i don't know how to add page break after each table.

Sub ImportWordTable()Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Word
Dim jRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
    If wdDoc.tables.Count = 0 Then
        MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
    Else
        jRow = 0
        Sheets.Add after:=Sheets(Worksheets.Count)
        For TableNo = 1 To wdDoc.tables.Count
            With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    jRow = jRow + 1
                    For iCol = 1 To .Columns.Count
                        On Error Resume Next
                        ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                        On Error GoTo 0
                    Next iCol
                Next iRow
            End With
            jRow = jRow + 1
        Next TableNo
    End If
End With
Set wdDoc = Nothing
End Sub

And next thing is to read word file and import the tables inside the excel. Here I have a few questions, when I run this script I get the super clean file and I am ok with that, i just need to add that every table go on separate spreadsheet.

https://photos.app.goo.gl/YBmrakprxqyhwtgR7
From the image you can see on the left side the text that was manually input, but on the right side is directly from the excel, What I am missing on the right side is the enters. Is that possible to accomplished inside this script.

here is the code

Sub ImportWordTable()Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Word
Dim jRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
    If wdDoc.tables.Count = 0 Then
        MsgBox "This document contains no tables", _
            vbExclamation, "Import Word Table"
    Else
        jRow = 0
        Sheets.Add after:=Sheets(Worksheets.Count)
        For TableNo = 1 To wdDoc.tables.Count
            With .tables(TableNo)
'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    jRow = jRow + 1
                    For iCol = 1 To .Columns.Count
                        On Error Resume Next
                        ActiveSheet.Cells(jRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                        On Error GoTo 0
                    Next iCol
                Next iRowff
            End With
            jRow = jRow + 1
        Next TableNo
    End If
End With
Set wdDoc = Nothing
End Sub

thnx in advance

 

[Macropod]

You might, for example, use something like:

Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim t As Long 'table number in Word
Dim c As Long 'columns in Excel
Dim r As Long 'rows in Excel
Dim xlWkBk As Workbook
Dim xlWkSht As Worksheet
Set xlWkBk = ActiveWorkbook
wdFileName = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
    "Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Set wdDoc = GetObject(wdFileName) 'open Word file
With wdDoc
    If wdDoc.Tables.Count = 0 Then
        MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
    Else
        For t = 1 To wdDoc.Tables.Count
            Set xlWkSht = Sheets.Add(After:=Sheets(xlWkBk.Worksheets.Count))
            .Tables(t).Range.Copy
            With xlWkSht
                .Paste xlWkSht.Range("A1")
                c = .UsedRange.Columns.Count
                r = .UsedRange.Columns.Count
                .Range("A1:" & .Cells(r, c).Address).WrapText = False
                .Columns("A:" & Chr(64 + .UsedRange.Columns.Count)).AutoFit
            End With
        Next t
    End If
End With
Set wdDoc = Nothing: Set xlWkSht = Nothing: Set xlWkBk = Nothing
End Sub

Note: the above code preserves the Word formatting, though column widths may vary.