VBA to copy specific word data to excel

[Bipin123]

Hello Experts,

I have researched multiple threads related to coping data from word to excel, But is not working for me. I also tried manipulating different codes but as I am new to VBA all efforts failed. Sincerely seeking help from the experts.

My project needs to extract specific data from the word files in the folder. Attached is the screen shot below of the word format. I need to copy all the data coded in yellow as headers columns in excel & the data coded in red as values . Sample word format and sample Excel sheets are attached as picture file for easy understanding.

Sample Excel sheet as follows:-

Hope to hear from you soon.

Regards
Bipin

 

[earthworm]

Below is the sample Macro that will import all fields from word in excel . I leave the rest for remaining experts to customize as per your requirement.

In my view it can be done through one macro to import data and another macro to further customize the copied data in excel as required.

Sub ImportWord()

Dim objWord As Object
Dim objDoc As Object
Dim wdFileName

Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")

If wdFileName = False Then Exit Sub

Set objDoc = GetObject(wdFileName)

objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy

Worksheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste

objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit

End Sub

 

[Bipin123]

Below is the sample Macro that will import all fields from word in excel . I leave the rest for remaining experts to customize as per your requirement.

In my view it can be done through one macro to import data and another macro to further customize the copied data in excel as required.

Sub ImportWord()

Dim objWord As Object
Dim objDoc As Object
Dim wdFileName

Set objWord = CreateObject("word.Application")
wdFileName = Application.GetOpenFilename("Word Documents, *.doc*")

If wdFileName = False Then Exit Sub

Set objDoc = GetObject(wdFileName)

objWord.Documents.Open (wdFileName)
objWord.Selection.WholeStory
objWord.Selection.Copy

Worksheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste

objDoc.Close SaveChanges:=wdDoNotSaveChanges
objWord.Quit

End Sub

Thank you for your Respose.

I did use this code earlier, but is copying all the content, which includes pictures as well to cell A1, which makes it difficult to search.
I am not sure, if we can make search a specific key word, then offset and copy the adjacent data to the sheet.

 

[earthworm]

Thank you for your Respose.

I did use this code earlier, but is copying all the content, which includes pictures as well to cell A1, which makes it difficult to search.
I am not sure, if we can make search a specific key word, then offset and copy the adjacent data to the sheet.Why

Once the data is copied create another macro that will customize the data in excel and paste into new excel without objects .

while recording macro to hide objects press ctrl+6 first and then do your copy paste stuff.

Once second macro is complete you can then merge into single macro. Use steps in first and then merge into single macro.

If you share the template that can be copied from here I can help further as you have shared the image.

 

[Bipin123]

Thanks again for looking into it.

Yes, I can share a copy of the template, I am not seeing an option here to upload a word file. Do you know how to do it?

 

[earthworm]

Just try pasting the format here directly from Word file (CTRL+A CTRL+C ) and then paste here CTRL+V

Thanks again for looking into it.

Yes, I can share a copy of the template, I am not seeing an option here to upload a word file. Do you know how to do it?