Excel-VBA program to copy all word tables and paste into excel

Excel VBA Program to copy all the tables present in word file and paste it into Activesheet.

Sub copy_wordtables()

Dim doc As New Word.Application    ''''''  Tools --> reference -->Microsoft word 12.0 object library''
Dim data As Variant

MsgBox "Open Any Word File Which Contains Table", vbOKOnly, "OPEN WORD FILE"
doc.Documents.Open Application.GetOpenFilename
doc.Visible = 1

For i = 1 To doc.ActiveDocument.Tables.Count

For j = 1 To doc.ActiveDocument.Tables(i).Columns.Count

For k = 1 To doc.ActiveDocument.Tables(i).Columns(j).Cells.Count
data = doc.ActiveDocument.Tables(i).Columns(j).Cells(k).Range.Text
Cells(k, j) = Left(data, Len(data) - 2)
Next k
Next j
Next i

doc.Quit
Set doc = Nothing
ActiveWorkbook.Close savechanges = 1
End Sub


Sample file for the above VBA Program:----------------------------

Download Macro File