• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Code to copy tables from word based on page numbers(say 6-9) to spreadsheet

ArunARR

New Member
I created a code which performs as below

This code opens the word document

Counts the table from the document

Copies all tables from the document

Pastes all tables from the document

I tried different tutorials and failed.Suggestion requested on how to copy tables from a specified page range when the user gives in a input box. Provided the code below.

>>> use code - tags <<<
Code:
Sub importTableDataWord()
Dim WdApp As Object, wddoc As Object
Dim strDocName As String
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number = 429 Then
Err.Clear
Set WdApp = CreateObject("Word.Application")
End If
WdApp.Visible = True

strDocName = "C:\our-inventory\inventory.docx"

If Dir(strDocName) = "" Then
MsgBox "The file " & strDocName & vbCrLf & _
"was not found in the folder path" & vbCrLf & _
"C:\our-inventory\.", _
vbExclamation, _
"Sorry, that document name does not exist."
Exit Sub
End If

WdApp.Activate

Set wddoc = WdApp.Documents(strDocName)

If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName)
wddoc.Activate
Dim Tble As Integer
Dim Pages
Dim rowWd As Long
Dim colWd As Integer
Dim x As Long, y As Long
x = 1
y = 1
With wddoc
        Tble = wddoc.tables.Count
        If Tble = 0 Then
       
            MsgBox "No Tables found in the Word document", vbExclamation, "No Tables to Import"
            Exit Sub
        End If
        
        
        For i = 1 To Tble
With .tables(i)
             For rowWd = 1 To .Rows.Count
             For colWd = 1 To .Columns.Count
             Cells(x, y) = WorksheetFunction.Clean(.cell(rowWd, colWd).Range.Text)
            
                        y = y + 1
                       
                    Next colWd
                    y = 1
                    x = x + 1
                   
                Next rowWd
End With
       
        Next
    End With



wddoc.Close Savechanges:=False

WdApp.Quit


Set wddoc = Nothing
Set WdApp = Nothing


End Sub
 
Last edited by a moderator:
Back
Top