Dim FSO As Object
  Dim FromPath As String
  Dim ToPath As String
  Dim Fdate As Date
  Dim FileInFromFolder As Object

  FromPath = "H:testfrom"
  ToPath = "H:testto"

  Set FSO = CreateObject("scripting.filesystemobject")
  For Each FileInFromFolder In FSO.getfolder(FromPath).Files
  Fdate = Int(FileInFromFolder.DateLastModified)
      If Fdate >= Date - 1 Then

        FileInFromFolder.Copy ToPath

    End If
Next FileInFromFolder
End Sub

Public Sub PerformCopy()
    CopyFiles "H:testfrom", "H:testto"
End Sub


Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
    Set FSO = CreateObject("scripting.filesystemobject")
    'First loop through files
    For Each FileInFromFolder In FSO.getfolder(strPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        If Fdate >= Date - 1 Then
            FileInFromFolder.Copy strTarget
        End If
    Next FileInFromFolder


    'Next loop throug folders
    For Each FolderInFromFolder In FSO.getfolder(strPath).SubFolders
        CopyFiles FolderInFromFolder.Path, strTarget
    Next Folder
End Sub

Private Sub Command3_Click()

Dim objFSO As Object 'FileSystemObject
Dim objFile As Object 'File
Dim objFolder As Object 'Folder
Const strFolder As String = "H:testfrom2"
Const strNewFolder As String = "H:testto"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFolder In objFSO.GetFolder(strFolder & "").SubFolders
    'If Right(objFolder.Name, 2) = "tb" Then
        For Each objFile In objFolder.Files
            'If InStr(1, objFile.Type, "Excel", vbTextCompare) Then
                On Error Resume Next
    Kill strNewFolder & "" & objFile.Name
 Err.Clear: On Error GoTo 0

                Name objFile.Path As strNewFolder & "" & objFile.Name
            'End If
        Next objFile
    'End If
Next objFolder


End Sub

==================== call ================================
MkDir "DestinationPath"

CopyFiles "SourcePath" & "", "DestinationPath" & ""

==================== Copy sub ===========================

Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
Dim FSO As Object
Dim FileInFromFolder As Object
Dim FolderInFromFolder As Object
Dim Fdate As Long
Dim intSubFolderStartPos As Long
Dim strFolderName As String

Set FSO = CreateObject("scripting.filesystemobject")
'First loop through files
    For Each FileInFromFolder In FSO.GetFolder(strPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        'If Fdate >= Date - 1 Then
            FileInFromFolder.Copy strTarget
        'end if
    Next

    'Next loop throug folders
    For Each FolderInFromFolder In FSO.GetFolder(strPath).SubFolders
        'intSubFolderStartPos = InStr(1, FolderInFromFolder.Path, strPath)
        'If intSubFolderStartPos = 1 Then

        strFolderName = Right(FolderInFromFolder.Path, Len(FolderInFromFolder.Path) - Len(strPath))
        MkDir strTarget & "" & strFolderName

        CopyFiles FolderInFromFolder.Path & "", strTarget & "" & strFolderName & ""

    Next 'Folder

End Sub