Macro Compiles Sheets to One Book...Small Modification Needed

[TEAM]

I have been using the following macro to collect all of the first sheet
stored in multiple workbooks. Now, I am trying to change this macro s
that it will collect all of the sheets in each of the workbooks and no
just the first sheet in each book. Any ideas?


Code
-------------------
Sub GetFiles()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\desktop\testfolder"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Left(mybook.Name, Len(mybook.Name) - 4)
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True

Application.DisplayAlerts = False
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False




End Su

 

[Ron de Bruin]

Hi Team

mybook.Worksheets.Copy after:= _

You can use this but what do you want to do with the sheet names ?

On Error Resume Next
ActiveSheet.Name = Left(mybook.Name, Len(mybook.Name) - 4)
On Error GoTo 0