çalışma sayfalarının kopyalanması

[aoc]

slm,

aşağıdaki kod 1 klasör içindeki çalışma kitaplarındaki tüm çalışma sayfalarını excel e kopyalamaktadır.fakat alt klasör içinde bulunun excel dosyalarını taramamaktadır.bütün klasörler taranacak şekilde kodu nasıl değiştirebiliriz ?

Sub copyworksheets()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String


SaveDriveDir = CurDir
MyPath = "D:\folder"


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.Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name ' Or use 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
End Sub