Bonjour,

j'ai réalisé un bout de code VBA qui réalise plusieurs boucles dans l'intérieur de boucles... Le résultat fonctionne sans problème mais cela est très long pour traiter des milliers de lignes. Je suis persuadé que mon code est très loin d'être parfait et optimisé et j'ai besoin de vos lumières pour voir si je ne pourrais pas le modifier pour gagner en vitesse de traitement.

Voici le 1er code :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub bloc_tag1() 'Import des groupes de tag
 
Application.ScreenUpdating = False
 
Dim FL1 As Worksheet, Cell As Range, NoCol As Integer
Dim NoLig As Long, derlig As Long, Var As Variant
 
    'Instance de la feuille qui permet d'utiliser FL1 partout dans
    'le code à la place du nom de la feuille
    Set FL1 = Worksheets("Vidus")
 
    'Détermine la dernière ligne renseignée de la feuille de calculs
 
    derlig = Split(FL1.UsedRange.Address, "$")(4)
 
    'Fixe le N° de la colonne à lire
    NoCol = 1
 
 
    For NoLig = 1 To derlig
        Var = FL1.Cells(NoLig, NoCol)
 
    Sheets("Vidus").Select
 
 
 
lignedeb = Range("B" & NoLig).Value
lignefin = Range("C" & NoLig).Value
 
 
    Sheets("FICHIER").Select ' Récupèration bloc VIDUS
     Range("A" & lignedeb & ":A" & lignefin).Select
    Selection.Copy
    Sheets("GroupeTAG").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1").Select
 
 
    envoibdd
 
    Sheets("GroupeTAG").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
 
      Next
    Set FL1 = Nothing
 
        Sheets("FICHIER").Select
    Range("A1").Select
 
    Application.ScreenUpdating = True
 
 
End Sub
qui appelle le sub envoibdd ci-dessous :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Sub envoibdd() 'Cherche 1 mot et marque la ligne
Dim rg As Range
Dim FL1 As Worksheet, Cell As Range, NoCol As Integer
Dim NoLig As Long, derlig As Long, Var As Variant
Dim Texte As String
Dim derligne As Long
 
     Sheets("GroupeTAG").Select
 
    Application.ScreenUpdating = False
 ' Application.Calculation = xlManual
  Application.DisplayStatusBar = False
 
    'Instance de la feuille qui permet d'utiliser FL1 partout dans
    'le code à la place du nom de la feuille
    Set FL1 = Worksheets("GroupeTAG")
 
        'Détermine la dernière ligne renseignée de la feuille de calculs
 
    derlig = Split(FL1.UsedRange.Address, "$")(4)
 
      'Fixe le N° de la colonne à lire
    NoCol = 1
 
 
    For NoLig = 1 To derlig
 
 
 
        If Range("A" & NoLig).Value Like "0 A*" Then
 
        Var1 = Range("A" & NoLig).Value
 
    End If
 
    If Range("A" & NoLig).Value Like "2 RN *" Then
 
        Var2 = Range("A" & NoLig).Value
 
     End If
 
     If Range("A" & NoLig).Value Like "2 VN *" Then
 
        Var3 = Range("A" & NoLig).Value
 
        End If
 
    If Range("A" & NoLig).Value Like "1 SX *" Then
 
        Var4 = Range("A" & NoLig).Value
 
        End If
 
    If Range("A" & NoLig).Value Like "1 ACCU *" Then
 
        Var5 = Range("A" & NoLig).Value
 
        End If
 
 
 
    If Range("A" & NoLig).Value Like "1 GN *" Then
 
        Var8 = Range("A" & NoLig).Value
 
        End If
 
            If Range("A" & NoLig).Value Like "1 AMS*" Then
 
        Var6 = Range("A" & NoLig).Value
 
 
        End If
 
             If Range("A" & NoLig).Value Like "1 _FI*" Then
 
 
 
        Var7 = Range("A" & NoLig).Value
 
       End If
 
 If Range("A" & NoLig).Value Like "1 AMC*" Then
 
        Var9 = Range("A" & NoLig).Value
 
        End If
 
        finmot = Range("A" & derlig).Value
 
  If Range("A" & NoLig).Value Like finmot Then
 
        Sheets("BDD").Select
 
        derligne = Range("A" & Rows.Count).End(xlUp).Row
        derligne = derligne + 1
 
        Range("A" & derligne).Value = Var1
        Range("B" & derligne).Value = Var2
        Range("C" & derligne).Value = Var3
        Range("D" & derligne).Value = Var4
        Range("E" & derligne).Value = Var5
 
        Range("H" & derligne).Value = Var6
        Range("K" & derligne).Value = Var7
        Range("J" & derligne).Value = Var8
        Range("I" & derligne).Value = Var9
 
        Sheets("GroupeTAG").Select
 
    End If
 
    Next
    Set FL1 = Nothing
 
     Application.ScreenUpdating = True
  'Application.Calculation = xlManual
  Application.DisplayStatusBar = True
 
End Sub
En vous remerciant pour vos conseils