Extract data from Word to Excel

janicefool

New Member
Joined
Sep 23, 2020
Messages
9
Office Version
  1. 2016
Platform
  1. Windows
Would like to ask if there's a way to extract data from MS Word to Excel?

I have a WORD file with the format set. I want to extract the data from Word to Excel for every new Word doc.

My daily tasks requires me to create new word doc in that format and then transfer the information from that word document into EXCEL. Is there a way to do it?
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
as example

VBA Code:
Sub CopyWord()

Call CreateNewWord


Dim WB As Workbook
Dim WS As Worksheet
Dim wrdApp As Object
Dim WrdDoc As Object
Dim myRange
Dim myTabel
Set WB = ThisWorkbook
Set WS = WB.Worksheets(1) '"Sheet1" or any Name "Sheet_Name"
Set wrdApp = CreateObject("Word.Application")

Path = Environ("USERPROFILE") & "\" & "Desktop"
WrdPath = Path & "\" & "wrd.docx"

Set WrdDoc = wrdApp.documents.Open(WrdPath)
wrdApp.Visible = True

''''''''''''word'''''''''''''
With WrdDoc
.Content.WholeStory
.Content.Copy
End With

''''''''''''Excel'''''''''''''

With WS
.Cells(15, 1).Select
.Paste
End With
    WrdDoc.Close SaveChanges:=wdDoNotSaveChanges
    wrdApp.Quit
Set WrdDoc = Nothing
Set wrdApp = Nothing

End Sub
Sub CreateNewWord()

Dim WB As Workbook
Dim WS As Worksheet
Dim wrdApp As Object
Dim WrdDoc As Object
Dim myRange
Dim myTabel
Set WB = ThisWorkbook
Set WS = WB.Worksheets(1) '"Sheet1" or any Name "Sheet_Name"

Dim WrdPath As String
Path = Environ("USERPROFILE") & "\" & "Desktop"
WrdPath = Path & "\" & "wrd.docx"
On Error Resume Next
If Len(Dir$(WrdPath)) > 0 Then Kill WrdPath
On Error GoTo 0
Set wrdApp = CreateObject("Word.Application")
Set WrdDoc = wrdApp.documents.Add
wrdApp.Visible = True

WrdDoc.SaveAs WrdPath
'do what
'add table
Set myRange = WrdDoc.Range(0, 0)

'cop from excel
WS.Range("A1:D5").Copy
wrdApp.Selection.Paste 'Special Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        
 'or wrting  text
 wrdApp.Selection.TypeParagraph

wrdApp.Selection.Range.InsertAfter Text:=vbNewLine & vbNewLine & "MR EXCEL" & vbNewLine & "Thanks"
Set myTabel = WrdDoc.Tables.Add(Range:=myRange, NumRows:=3, NumColumns:=4)
myTabel.Borders.Enable = True
myTabel.Cell(1, 1).Range.Text = "Hi"
myTabel.Cell(1, 2).Range.Text = "Good"
myTabel.Cell(2, 1).Range.Text = "Very Good"
wrdApp.Selection.TypeParagraph
wrdApp.Activate

WrdDoc.Close True
wrdApp.Quit

Set WrdDoc = Nothing
Set wrdApp = Nothing

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,126,986
Messages
5,621,995
Members
415,873
Latest member
fuulhouse

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top