Code très lent

Bonjour
Ce code me permet de regrouper tous mes fichiers XL mais est Hyper long
Quelqu'un aurait-il une idée pour accélerer ou un autre code?
Merci
Pascal
Sub CopierFichiers()

Dim fso As Object
Dim strFile As String
Dim i As Integer
'Crée un nouveau repertoire si non existant
Set fso = CreateObject("Scripting.fileSystemObject")
If Not fso.folderExists("C:Tout mon XL") Then
fso.createFolder ("C:Tout mon XL")
End If
'Recherche les fichiers excel et les copie dans le repertoire
With Application.FileSearch
.LookIn = "C:"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
fso.CopyFile .FoundFiles(i), "C:Tout mon XL"
Next i
End With
End Sub

---
Antivirus avast! : message Sortant sain.
Base de donnees virale (VPS) : 000723-0, 11/03/2007
Analyse le : 12/03/2007 08:42:18
avast! - copyright (c) 1988-2007 ALWIL Software.
http://www.avast.com

Bonjour, Pascal
Je me permets car j'ai fait une réponse quasiment identique ce matin sur
le forum Access.
Je n'ai pas regardé plus en détail mais tu devrais pouvoir gagner du temps
au niveau de la boucle avec ceci:

Dim TonFichier As Object
For Each TonFichier In .FoundFiles
fso.CopyFile TonFichier, "C:Tout mon XL"
Next TonFichier

Est-ce plus rapide ?
--
Bonne continuation

Bonjour
Ce code me permet de regrouper tous mes fichiers XL mais est Hyper long
Quelqu'un aurait-il une idée pour accélerer ou un autre code?
Merci
Pascal
Sub CopierFichiers()

Dim fso As Object
Dim strFile As String
Dim i As Integer
'Crée un nouveau repertoire si non existant
Set fso = CreateObject("Scripting.fileSystemObject")
If Not fso.folderExists("C:Tout mon XL") Then
fso.createFolder ("C:Tout mon XL")
End If
'Recherche les fichiers excel et les copie dans le repertoire
With Application.FileSearch
.LookIn = "C:"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
fso.CopyFile .FoundFiles(i), "C:Tout mon XL"
Next i
End With
End Sub

---
Antivirus avast! : message Sortant sain.
Base de donnees virale (VPS) : 000723-0, 11/03/2007
Analyse le : 12/03/2007 08:42:18
avast! - copyright (c) 1988-2007 ALWIL Software.
http://www.avast.com

---
Antivirus avast! : message Entrant sain.
Base de donnees virale (VPS) : 000723-0, 11/03/2007
Analyse le : 12/03/2007 18:15:05
avast! - copyright (c) 1988-2007 ALWIL Software.
http://www.avast.com

Dim fso As Object
Dim strFile As String
Dim i As Integer
'Crée un nouveau repertoire si non existant
Set fso = CreateObject("Scripting.fileSystemObject")
If Not fso.folderExists("C:Tout mon XL") Then
fso.createFolder ("C:Tout mon XL")
End If
'Recherche les fichiers excel et les copie dans le repertoire
With Application.FileSearch
.LookIn = "C:"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
fso.CopyFile .FoundFiles(i), "C:Tout mon XL"
Next i
End With
End Sub