copier un fichier d'un repertoire à un autre a partir de liste excel

Option Explicit
Sub test()
Dim t As String
t = "P_BCCM08_ELE_0012364_400000259876_0010.pdf"
If t Like "*400000259876*" Then MsgBox "Trouvé..."
End Sub

Dim Fichier As Object
Repertoire = "c:\Tmp"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set DossierSource = FSO.GetFolder(Repertoire)
For Each Fichier In DossierSource.Files
      NomFich = Fichier.Name
      If InStr(NomFich , "400000259876") then Traitement_Copie_Fichier 
      
      'Utilisation de like
      If NomFich Like "*400000259876*" Then Traitement_Copie_Fichier

Next Fichier

Sub ListeArborescence(Dossier As String)
Dim fs As Object, sousdoss As Object, Racine As Object
Dim CheminComplet As String, SousRep As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set Racine = fs.GetFolder(Dossier)
For Each sousdoss In Racine.SubFolders
    'pour récupérer le chemin complet
    CheminComplet = sousdoss.Path
    'pour récupérer uniquement le nom du dossier
    SousRep = sousdoss.Name
    ReDim Preserve ListeDoss(1 To UBound(ListeDoss) + 1)
    ListeDoss(UBound(ListeDoss)) = CheminComplet
    ListeArborescence CheminComplet
Next sousdoss
End Sub

Sub lanceliste(Dossier As String)
    ReDim ListeDoss(1 To 1)
    ListeDoss(1) = Dossier
    ListeArborescence Dossier
End Sub

Public Sub ChercherFichiers(Dossier As String)
Dim Fs As Object
Dim Racine As Object
Dim Fichier As Object
Dim NomFich As String
Dim i As Integer
Set Fs = CreateObject("Scripting.FileSystemObject")
Set Racine = FSO.GetFolder(Dossier)
i = 1
For Each Fichier In Racine.Files
    NomFich = Fichier.Name
    If NomFich Like "*P_BCCM08_ELE_0012364_400000259876_0010.pdf*" Or NomFich _
        Like "*400000259876*" Then
        'Et hop tu les ranges pour le réutiliser : adapter les colonnes
        Range("B" & i) = NomFich
        Range("C" & i) = Dossier
        i = i + 1
    End If
Next Fichier
Set DossierSource = Nothing
Set FSO = Nothing
End Sub