Hi,
You may want to try the following:
Sub CopySheets()
Const DeskTopDir = "c:winntprofilesall usersdesktop"
Dim iFileName As String
Dim iWorkBook As String
iWorkBook = ThisWorkbook.Name
iFileName = Dir(DeskTopDir)
Do While iFileName <> ""
If LCase(Right(iFileName, 4)) = ".xls" Then
Workbooks.Open (DeskTopDir & iFileName)
Sheets("sheet1").Name = Left(iFileName, Len(iFileName) - 4)
Sheets(Left(iFileName, Len(iFileName) - 4)).Copy _
After:=Workbooks(iWorkBook).Sheets(Workbooks(iWorkBook).Sheets.Count)
Workbooks(iFileName).Close (False)
End If
iFileName = Dir
Loop
End Sub
For the desktop directory, you might have to change it to whatever desktop directory on yours, eg. windows 98 would be something like : c:windowsdesktop, etc.
And if the name of the sheet you wanted to copy is not called "sheet1", then you also have to change that. Alternatively, if you want to copy the first of the workbook, instead of using 'sheets("sheet1")', change it to 'sheets(1)'.
HTH