Not tested

Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "C:\My Documents"
.Filename = "*.doc"
.SearchSubFolders = True
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles


If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) 0 Then
' MsgBox "There were " & .FoundFiles.Count & _
' " file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
Activeworkbook.SaveAs "D:\" & Activeworkbook.Name
Activeworkbook.Close Savechanges:=False
Next i
Else
MsgBox "There were no files found."
End If


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Shane" wrote in message
...
Hi all,

Would you be able to advise how I could copy the files found by the
following macro to a another directory - say D:\Data

Set fs = Application.FileSearch
With fs
.NewSearch
.LookIn = "C:\My Documents"
.Filename = "*.doc"
.SearchSubFolders = True
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles


If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) 0 Then
' MsgBox "There were " & .FoundFiles.Count & _
' " file(s) found."
For i = 1 To .FoundFiles.Count
MsgBox .FoundFiles(i)
Next i
Else
MsgBox "There were no files found."
End If
Thanks