Sub copysheets()
Dim wkbk As Workbook
Dim wkbk1 As Workbook
Dim sName As String
Dim i As Long

On Error Resume Next
Set wkbk = Workbooks("tot01.xls")
On Error GoTo 0
If wkbk Is Nothing Then
Set wkbk = Workbooks.Open( _
"C:\My Documents\Data\Consol\tot01.xls")
End If
With Application.FileSearch
.NewSearch
.LookIn = "C:\My Documents\Data\month01"
.SearchSubFolders = True
.FileName = ".xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks

If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
Set wkbk1 = Workbooks.Open( _
.FoundFiles(i))
sName = wkbk1.Worksheets(2). _
Range("C2").Value
wkbk1.Worksheets(2).Copy _
After:=wkbk.Worksheets( _
wkbk.Worksheets.Count)
wkbk.Worksheets(wkbk.Worksheets. _
Count).Name = sName
wkbk1.Close SaveChanges:=False
Next i
wkbk.Save
Else
MsgBox "There were no files found."
End If
End With
End Sub


--
Regards,
Tom Ogilvy

Mike Taylor wrote in message
m...
Can anyone share idea(s) for code that will programatically loop
through all the .xls files in a directory and copy the second sheet
all the .xls files in the "C:\My Documents\Data\month01" directory to
a workbook named "tot01.xls" [path is "C:\My
Documents\Data\Consol\tot01.xls"] and then name each sheet copied
using the value in cell C2 of each of the sheets after it is copied?
Any ideas are greatly appreciated.