Macro to copy all tables from a document and paste them in a separate workbook-
Sub import_word_tables_seperate_workbook()
Dim objWord As Object
Dim objdoc As Object
Dim i As Integer
Dim wkb As Workbook
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objdoc = objWord.Documents.Open("C:\Users\ADMIN\Desktop\sample files\sample.docx") ' open the document
For i = 1 To objdoc.Tables.Count
objdoc.Tables(i).Range.Copy ' copy table
Set wkb = Workbooks.Add ' add new workbook
Range("a1").Select
ActiveSheet.Paste ' paste table
wkb.SaveAs "C:\Users\ADMIN\Desktop\sample files\Table_" & i & ".xlsx" ' save workbook with table name
wkb.Close
Set wkb = Nothing
Next
objdoc.Close
objWord.Quit
Set objdoc = Nothing
Set objWord = Nothing
End Sub
Sub import_word_tables_seperate_workbook()
Dim objWord As Object
Dim objdoc As Object
Dim i As Integer
Dim wkb As Workbook
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objdoc = objWord.Documents.Open("C:\Users\ADMIN\Desktop\sample files\sample.docx") ' open the document
For i = 1 To objdoc.Tables.Count
objdoc.Tables(i).Range.Copy ' copy table
Set wkb = Workbooks.Add ' add new workbook
Range("a1").Select
ActiveSheet.Paste ' paste table
wkb.SaveAs "C:\Users\ADMIN\Desktop\sample files\Table_" & i & ".xlsx" ' save workbook with table name
wkb.Close
Set wkb = Nothing
Next
objdoc.Close
objWord.Quit
Set objdoc = Nothing
Set objWord = Nothing
End Sub
No comments:
Post a Comment