If iFile.Name Like "*+*.xls*" Then iFile.Copy "C:\Users\Мвидео\Desktop\Куда" & "\" & iFile.Name

For Each iFile In Folder.Files

Dim coll As Collection, ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%

    ПутьКПапке$ = [c1]    ' берём из ячейки c1
    МаскаПоиска$ = [c2]    ' берём из ячейки c2
    ГлубинаПоиска% = Val([c3])    ' берём из ячейки c3
    If ГлубинаПоиска% = 0 Then ГлубинаПоиска% = 999    ' без ограничения по глубине

    ' считываем в колекцию coll нужные имена файлов
    Set coll = FilenamesCollection(ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%)

Sub cop2()

Dim fso As Object, Folder As Object, iFile As Object, iPath$
iPath = "D:\PQ\Копирование между папками\Откуда"
Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 2) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(iPath)
For Each iFile In Folder.Files
If iFile.Name Like "*+*.xls*" Then iFile.Copy "D:\PQ\Копирование между папками\Куда" & "\" & iFile.Name
Next
Set iFile = Nothing
Set Folder = Nothing
Set fso = Nothing
End Sub

Sub cop3()

Dim fso As Object, Folder As Object, iFile As Object, iPath$
iPath = "D:\PQ\Копирование между папками\Откуда"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(iPath)
For Each SubFolder In Folder.SubFolders
    WScript.Echo SubFolder.Name
If iFile.Name Like "*+*.xls*" Then iFile.Copy "D:\PQ\Копирование между папками\Куда" & "\" & iFile.Name
Next
Set iFile = Nothing
Set Folder = Nothing
Set fso = Nothing
End Sub

Option Explicit
Sub test()
    Dim sInPath$, sOutPath$, oFSO As Object
    
    sInPath = "C:\Users\Мвидео\Desktop\Откуда"
    sOutPath = "C:\Users\Мвидео\Desktop\Куда"
    
    Set oFSO = CreateObject("scripting.filesystemobject")
    
    CopyRecursive oFSO, sInPath, sOutPath, "*.xls*"
        
    Set oFSO = Nothing
End Sub
Private Sub CopyRecursive(ByRef oFSO As Object, sCopyFrom$, sCopyTo$, sMask$)
    Dim oFile As Object, oFolder As Object
    Set oFolder = oFSO.GetFolder(sCopyFrom)
    For Each oFile In oFolder.Files
        If oFile.Name Like "*+*.xls*" Then oFile.Copy sCopyTo & "\" & oFile.Name
    Next
    For Each oFolder In oFolder.SubFolders
        CopyRecursive oFSO, oFolder.Path, sCopyTo, sMask
    Next
    Set oFile = Nothing
    Set oFolder = Nothing
End Sub

Dim fso As Object, Folder As Object, iFile As Object, iPath$
iPath = "D:\PQ\Копирование между папками\Откуда"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Folder = fso.GetFolder(iPath)
If iFile.Name Like "*+*.xls*" Then iFile.Copy "D:\PQ\Копирование между папками\Куда" & "\" & iFile.Name
Next
Set iFile = Nothing
Set Folder = Nothing
Set fso = Nothing
End Sub

For Each SubFolder In Folder.SubFolders
    WScript.Echo SubFolder.Name