Copy table column from multiple word files into excel
 

I have hundreds of word files in a folder. Each file contains a table with
two columns. I want to copy the right most column from each word file into 1
excel worksheet, but opening each word file individually and copy/pasting
will take me forever. Does anyone have code the will open each file in the
folder, copy the column and past it into the next available column in an
excel worksheet?

Thanks,
Ml

Copy table column from multiple word files into excel
 

This should do it. Make sure M/soft Word Object Library is ticked in Tools,
References in VB Editor and that your active sheet is the one you want them
pasted in (it'll all go wrong after col IV if you've more than 256 docs!):
Sub CopyColumns()
Dim fs As FileSearch
Dim i As Long
Dim myWord As New Word.Application
Set fs = Application.FileSearch
With fs
.LookIn = "C:\My Documents"
.SearchSubFolders = False
.Filename = "*.doc"
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
myWord.Documents.Open .FoundFiles(i)
myWord.ActiveDocument.Tables(1).Columns(2).Select
myWord.Selection.Copy
ActiveSheet.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(0, Selection.Columns.Count).Select
Selection.Resize(1, 1).Select
ActiveSheet.Paste
myWord.ActiveDocument.Close
Next
End If
End With
Set myWord = Nothing
End Sub


"ml_thompson" wrote:

I have hundreds of word files in a folder. Each file contains a table with
two columns. I want to copy the right most column from each word file into 1
excel worksheet, but opening each word file individually and copy/pasting
will take me forever. Does anyone have code the will open each file in the
folder, copy the column and past it into the next available column in an
excel worksheet?

Thanks,
Ml

Copy table column from multiple word files into excel
 

Thanks a million! It worked perfectly! You just saved me hours of work!!!

"Smallweed" wrote:

This should do it. Make sure M/soft Word Object Library is ticked in Tools,
References in VB Editor and that your active sheet is the one you want them
pasted in (it'll all go wrong after col IV if you've more than 256 docs!):
Sub CopyColumns()
Dim fs As FileSearch
Dim i As Long
Dim myWord As New Word.Application
Set fs = Application.FileSearch
With fs
.LookIn = "C:\My Documents"
.SearchSubFolders = False
.Filename = "*.doc"
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
myWord.Documents.Open .FoundFiles(i)
myWord.ActiveDocument.Tables(1).Columns(2).Select
myWord.Selection.Copy
ActiveSheet.Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(0, Selection.Columns.Count).Select
Selection.Resize(1, 1).Select
ActiveSheet.Paste
myWord.ActiveDocument.Close
Next
End If
End With
Set myWord = Nothing
End Sub


"ml_thompson" wrote:

I have hundreds of word files in a folder. Each file contains a table with
two columns. I want to copy the right most column from each word file into 1
excel worksheet, but opening each word file individually and copy/pasting
will take me forever. Does anyone have code the will open each file in the
folder, copy the column and past it into the next available column in an
excel worksheet?

Thanks,
Ml