Bonjour,

Je suis nouvelle sur ce forum, et j'ai un pb équivalent à celui de cette discussion.

Voici le contexte :
J'ai un code vba dans une base access, qui compare des data d'un fichier excel et de la database, les tries et export le tout dans un fichier excel puis pdf.
J'ai fait plusieurs macros liées les unes aux autres et l'un d'entre elle dure plus d'1 min et un autre 9 min !! Je cherche à optimiser le code afin de réduire ce temps de process.
Pourriez-vous m'aider ?
Ci-dessous quelques infos. Merci d'avance pour votre aide.
Diane

Le bout de code ci-dessous est pour la macro d'1 min: cette macro consiste à chercher les valeurs dans une plage de données de tous les onglets d'un fichier excel (jusqu'à 9 onglets - 2430 valeurs) et les coller dans une colonne dans un autre fichier ("strFilename").

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
    For Each Freezer In ActiveWorkbook.Worksheets
        Set Plage = Freezer.Range("C5:L63")
        'Boucle
        For Each Cell In Plage
            If Cell.Value <> Empty Then
                If Cell.Value <> "Rack ID" Then
                    'Copie les valeurs du freezer interface
                    Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Value = Cell.Value
                    'copie les couleurs
                    Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Interior.Color = Cell.Interior.Color
                    'copie le nom du freezer
                    Workbooks(strFilename).Worksheets(1).Range("A" & LinB).Value = Freezer.Name
 
                    LinB = LinB + 1
                Else
                End If
            End If
        Next
    Next
    End With
Le second bout de code ci-dessous (9 min) consiste à comparer et supprimer parmi les 2430 valeurs collées précédemment à celles initialement dans le fichier strFilename (64 valeurs max).

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
derlig = Workbooks(strFilename).Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row
 
    For i = 2 To derlig
        FindString = Workbooks(strFilename).Worksheets(1).Range("B" & i).Value
        If Trim(FindString) <> "" Then
            With Sheets(1).Range("E2:E65")
                Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                If Rng Is Nothing Then
                    Sheets(1).Range("A" & i).Delete Shift:=xlUp
                    Sheets(1).Range("B" & i).Delete Shift:=xlUp
 
                    i = i - 1
                Else
                    Sheets(1).Range("C" & Rng.Row).Copy
                    Sheets(1).Range("F" & i).PasteSpecial xlPasteAll
                    Sheets(1).Range("D" & Rng.Row).Copy
                    Sheets(1).Range("G" & i).PasteSpecial xlPasteAll
 
                End If
            End With
        End If
    Next