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



## Abhishekghorpade (Oct 3, 2018)

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 (Oct 4, 2018)

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 (Oct 5, 2018)

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 (Oct 5, 2018)

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 (Oct 5, 2018)

Simply insert:
Call DeleteAllPics
after:
wdApp.Quit


----------

