Give the code after my signature a try. It is a modification of your
originally posted code where I removed the need to open the file. The folder
name to skip needs to be set in the Const statement I added just after the
Dim statements. I also added a couple of comments to help you figure out
what I did. If you have any questions about my code, feel free to ask.

Rick

'******************** START OF CODE ********************
Sub CreateCopy()
Dim i As Integer
Dim MyBook As Workbook
Dim FileName As String
Dim LastFolder As String
Dim MyFilePath As String
Dim PathParts() As String
Const FolderToSkip As String = "SubFolder 1"
With Application.FileSearch
.NewSearch
.LookIn = "H:\Main Folder"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
' Break the path/filename up into parts
PathParts = Split(.FoundFiles(i), "\")
FileName = PathParts(UBound(PathParts))
LastFolder = PathParts(UBound(PathParts) - 1)
' This statement will skip over files belonging to the
' folder name declared in the FolderToSkip constant
If StrComp(LastFolder, FolderToSkip, vbTextCompare) < 0 Then
' Determine which folder
If FileName Like "*Paris*" Then
MyFilePath = "H:\Paris\"
ElseIf FileName Like "*London*" Then
MyFilePath = "H:\London\"
ElseIf FileName Like "*Rome*" Then
MyFilePath = "H:\Rome\"
End If
' If file is in one of the above folders, copy it
If Len(MyFilePath) 0 Then
FileCopy .FoundFiles(i), MyFilePath & FileName
End If
End If
Next
End If
End With
MsgBox "DONE"
End Sub
'******************** END OF CODE ********************

"Tendresse" wrote in message
...
I need some help with the following code, please.
I have a big number of Excel workbooks saved as follows:

H\Drive: Main Folder (containing the following subfolders):
SubFolder 1
SubFolder 2
etc
SubFolder 50

Inside each one from SubFolder 2 through 50, there are 10 workbooks. The
exception is SubFolder 1 that has 100 workbooks.

What i want to do is to go through SubFolders 2 to 50 and make a copy of
only 3 workbooks in each of these SubFolders to a different destination.
The
following code is very close to what i want to achieve, however i need to
adjust 2 things:

First: i want to add in there something to 'Skip' SubFolder 1 (i don't
need
to make a copy of any of the workbooks in there)

Second: how can i make the copy of the workbooks i need without having to
open them?

I'm using Excel 2003.
Any help is much appreciated.
Tendresse
_________________
Sub CreateCopy()

Dim MyBook As Workbook
Dim MyFilePath As String
Dim i As Integer

' Search for the Excel files in the Main Folder

With Application.FileSearch
.NewSearch
.LookIn = "H:\Main Folder"
.SearchSubFolders = True ' how do i say here 'except the first
one'
.FileType = msoFileTypeExcelWorkbooks

' when files are found: copy and paste them in a different destination

If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
Set MyBook = Workbooks.Open(.FoundFiles(i), , True)

With MyBook
If .Name Like "*Paris*" Then
MyFilePath = "H:\Paris\"
.SaveCopyAs MyFilePath & .Name

ElseIf .Name Like "*London*" Then
MyFilePath = "H:\London\"
.SaveCopyAs MyFilePath & .Name

ElseIf .Name Like "*Rome*" Then
MyFilePath = "H:\Rome\"
.SaveCopyAs MyFilePath & .Name

End If

.Close (False)

End With
Next i
End If
End With
MsgBox "done"

End Sub