Il y avait le code de h2so4 plus bas mais la macro, si j'ai compris, elle cherche des fichiers dans tous c:\Users a hauteur de 10000 fichiers avec extension txt copie tous ses fichiers et va les mettre dans un nouveau dossier nommé srtest mais ne les supprime pas, j'ai essayé mais ça plante à la ligne "For Each f In fold.Files" j'ai activé la ref microsoft scripting runtime pourtant, ça serait presque ça ce que je voudrais sauf je veux pas de nouveau dossier et au lieu de copier je veux supprimer. Et j'imagine qu'en remplaçant ça "*.txt" par juste le fichier que je cherche "mon fichier.xlsm" ça doit pouvoir fonctionner aussi. Je précise que je fais sous Excel 2007
Sub listffolder()
Dim a(1 To 10000) 'max 10000 fichiers sélectionnés
sr = "c:\Users\srtest\" 'répertoire de destination (doit exister)
rep = "c:\Users" ' répertoire à examiner
listfolder rep, "*.txt", a, n
if n=0 then msgbox " pas de fichier trouvé":exit sub
Range("A1").Resize(n) = Application.Transpose(a)
For i = 1 To 10000
If a(i) = "" Then Exit For
s = InStrRev(a(i), "\")
nf = Left(a(i), s - 1) & ".txt"
s = InStrRev(nf, "\")
nf = Mid(nf, s + 1)
Cells(i, 2) = nf
FileCopy a(i), sr & nf
Next i
End Sub
Sub listfolder(folder, filtre, ByRef a, ByRef n)
Set fold = CreateObject("Scripting.FileSystemObject").GetFolder(folder)
For Each f In fold.SubFolders
If Right(f, 1) <> "\" Then listfolder f & "\", filtre, a, n Else listfolder f, filtre, a, n
Next
For Each f In fold.Files
If Right(f, 4) Like filtre Then
n = n + 1
a(n) = folder & f.Name
End If
Next
End Sub