Je récupère le contenu de plusieurs cellules identiques dans plusieurs fichiers d'un même répertoire (ex : A1, B45, C12 pour chaque fichiers) et je les visualise dans un tableau récapitulatif (pour chaque ligne une colonne correspondant aux cellules récupérées, dans mon cas, A1, B45, C12 dans A1, B1, C1)
J'ai écrit le code suivant qui fonctionne très bien, mais pour 100 fichiers qui écrit 100 lignes de résultat, il me faut 2mn minimum
 
Voici une partie de mon code :
 
Sub LancementGeneral()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
 
    Set objShell = CreateObject("Shell.Application" )
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1& )
 
If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
   
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    [X1] = Chemin
    fichier = Dir(Chemin & "*.xlsm" )
    Do While Len(fichier) > 0
     Application.ScreenUpdating = False
    If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$D$5"
            With Sheets("Feuil1" )
                .[X3] = "=Plage"
                .[X3].Copy
                Sheets("Feuil1" ).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                'CREATION FICHE
                 End With
        End If
        If fichier <> ThisWorkbook.Name Then
            ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$D$7"
            With Sheets("Feuil1" )
                .[X3] = "=Plage"
                .[X3].Copy
                Sheets("Feuil1" ).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                'MODIFICATION FICHE
                 End With
        End If
         
        'etc... pour les autres cellules à récupérer
         
       SUITE DU CODE JUSQU'A LA COMMANDE LOOP      
         
        fichier = Dir()
    Loop
End If
Range("C2:I100" ).Sort Key1:=Range("C2" ), Order1:=xlAscending, Key2:=Range( _
        "D2" ), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
        :=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
        DataOption2:=xlSortNormal
         
For Each C In Worksheets("Feuil1" ).Range("C2", "D200" )
C.Value = UCase(C.Value)
Next
For Each C In Worksheets("Feuil1" ).Range("F2", "G200" )
C.Value = UCase(C.Value)
Next
Application.ScreenUpdating = True
        End Sub
 
Si quelqu'un a une idée géniale de modification de mon code pour une vitesse de traitement rapide, je suis preneur
 
Merci d'avance
Cordialement  
 
 
 

Pour accélérer ton code, il faudrait déjà savoir ce qui le ralentit.
 
As-tu fait un chronométrage fonction par fonction pour voir ?
Insère dans ton code des lignes Debug.Print étiquette_X str(Now) où Etiquette_X est un repère pour savoir où est prise la mesure.
 
Tu auras ainsi un listing des fonctions horodatées dans la fenêtre d'exécution (menu Affichage / Fenêtre d'exécution).
 
Cela va encore ralentir le code mais tu sauras combien de temps tu passes entre chaque instruction et tu sauras donc quelle fonction est consommatrice.
 
D'instinct je dirais la création des plages nommées mais on ne sait jamais...

100 fichiers... 2mn...
Sélectionne tes 100 fichiers, clic droit, ouvrir, Excel devrait à peu près mettre le même temps... Ensuite appose une modif sur chaque et lance un enregistrement des fichiers en cascades, accès au disque par Excel et suppression des fichiers temp/sauv... Tu verras que 2mn c'est pas si long...
 
Enfin pour faire des traitements de stats et cie sur beaucoup de fichiers Excel, je ne trouve pas ça déconnant...
 
Après si tu es un serveurs avec whatmille threads, des ssd, 32Go de ram, oui c'est lent, sur un poste de bureautique je ne trouve pas ça déconnant...
 
Et sortir le application.screenupdating = false de ton do while non ?

Et tes derniers for each
Tu peux optimiser ça avec un seul
Je suis sur le tel, mais ça devrait le faire :

For Each C In Worksheets("Feuil1" ).Range("C2:D200","F2:G200" )
C.Value = UCase(C.Value) 
Next

Et pourquoi tester deux fois

If fichier <> ThisWorkbook.Name Then

en étant dans la même boucle ?

Salut, j'ai retrouvé ça : http://forum.hardware.fr/hfr/Progr [...] 0232_1.htm sous l'intitulé : Remise à jour du 09 Août 2007