Macro to Copy .xlsm workbooks from folder and sub-solder

I have written code to copy .xlsm files from folder and subfolder "C:\GL Reports" to C:\Old GL Reports"


When running my macro no .xlsm ae copied to C:\Old GL Reports"

Please Login or Register  to view this content.

It would be appreciated if someone could kindly amend my code

thanks for the help. my apologies I only wanted to copy (Not Move) the.xlsm workbooks from the folder C:\GL downloads as well as any sub-folders to C:\old GL Downloads


I amended my code as follows and it works perfectly

[]code] Sub Copyfiles()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim FSO As Object, fld As Object
Dim fname As Object
Dim sbfol As Object
Dim fpath As String, xpath As String
Dim tpath As String

fpath = "C:\GL Reports"
tpath = "C:\Old GL Reports"
If Right(fpath, 1) <> "\" Then fpath = fpath & "\"
If Right(tpath, 1) <> "\" Then tpath = tpath & "\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.getfolder(fpath)
If FSO.folderExists(fld) Then
For Each fname In fld.Files
If Right$(fname.Name, 4) = "xlsm" Then
xpath = fname.Path
FSO.copyfile Source:=xpath + fname, Destination:=tpath + fname
End If
Next

For Each sbfol In FSO.getfolder(fpath).subfolders
For Each fname In sbfol.Files
If Mid(fname.Name, InStrRev(fname.Name, ".") + 1) = "xlsm" Then

xpath = fname.Path

FSO.copyfile Source:=xpath, Destination:=tpath
End If
Next
Next
End If
End Sub [/code]