XL 2010 Comment copier tous les fichiers d'un répertoire et de ses sous-répertoires vers un dossier unique ?

Sub test()
    Dim racine$
    racine = "F:\windows seven"
    tableau = recherche_récursive(racine)
    Cells(1, 1).Resize(UBound(tableau) + 1, 1) = Application.Transpose(tableau)
End Sub
'
'
Private Function recherche_récursive(dparent, Optional L As String) As Variant
    Dim FSO As Object, Lparent As Object, SubFolder As Object, Ficher
    Set FSO = CreateObject("scripting.filesystemobject")    ' on declare l'object
    ' regard sur les fichiers
    Set Lparent = FSO.GetFolder(dparent)    'on attribue a l'object.getfolder le dossier demandé 'Scripting.Folder
    'MsgBox GetAttr(Lparent)
    If GetAttr(Lparent) <> 22 Then
        For Each Ficher In Lparent.Files    'on boucle sur les fichiers qui sont dans ce dossier
            L = L & Ficher & vbCrLf
        '!!!!!!!!!!!!!c'est ici qu'il faut faire la copie!!!!!!!!!!!!!
        Next

        'boucles sur les sous dossiers
        For Each SubFolder In Lparent.SubFolders    'on boucle sur les dossiers qui sont dans ce dossiers
            L = L & SubFolder.Path & vbCrLf
            recherche_récursive SubFolder.Path, L   ' on rappelle la fonction avec pour argument le chemin du sous dossier ainsi que l'extension et L qui est déjà peut être remplie
        Next SubFolder
    End If

    recherche_récursive = Split(L, vbCrLf)    'on coupe la liste par les saut de lignes on a maintenant un array la fonction devient cet array
End Function