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"

 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 Mid(fname.Name, InStrRev(fname.Name, ".") + 1) = "xlsm" Then

                xpath = fname.Path

                FSO.movefile Source:=xpath, Destination:=tpath
            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) = "xlsx" Then

                    xpath = fname.Path

                    FSO.movefile Source:=xpath, Destination:=tpath
                End If
            Next
        Next
    End If
End Sub

It would be appreciated if someone could kindly amend my code