Excel VBA to copy and move files

[patel]

not tested

Sub CopySubfoldersFile() 
Dim StrFile As String
   Dim objFSO, destRow As Long
   Dim mainFolder, mySubFolder
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   sFolder = "C:\MyData folder\08-12-13\"
tFolder ="C:\ForCompile\"
   Set mainFolder = objFSO.getfolder(sFolder)
   StrFile = Dir(sFolder & "*.xls*")
For Each mySubFolder In mainFolder.subfolders
         StrFile = Dir(mySubFolder & "\*.xls*")
         Do While Len(StrFile) > 0
       filecopy mySubFolder & "\" & StrFile, tFolder & StrFile
               StrFile = Dir
         Loop
Next
End Sub