Macro to copy data from multiple word doc to single new excel file

[Abhishekghorpade]

Hi,

I have 20 word document saved in a folder. I want to copy the data from all the files and paste it in a new single excel sheet.

Folder name - Downloads
Word document path - file:///C:\Users\E5554593\Downloads\
Word file name - Admin - Active Payroll Report, Admin - Active Payroll Report (1) and so on...

I am doing it manually which i hate it

 

[Macropod]

Try something based on:

Sub GetDocContent()
'Note: this code requires a reference to the Word object model. See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, lRow As Long
Dim WkSht As Worksheet: Set WkSht = ActiveSheet
strFolder = "C:\Users\" & Environ("UserName") & "\Downloads\"
strFile = Dir(strFolder & "*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  lRow = WkSht.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
  With wdDoc
    .Range.Copy
    WkSht.Paste WkSht.Range("A" & lRow)
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

 

[Abhishekghorpade]

Thank you so much... Its working..

Is there any way that we can delete the Image.. Every document has one Image which i need to delete manually...

 

[Abhishekghorpade]

I am currently using the below code to delete the Image

Sub DeleteAllPics()
Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic
End Sub

which is working fine but i need to run separately. Can you include this code in your coding.. Please.....

 

[Macropod]

Simply insert:
Call DeleteAllPics
after:
wdApp.Quit