Discussion :

[jpvba]

Bonjour a vous cher(e)s ami(e)s du forum,


J'ai un procédure fonctionnel mais très lente auquel je voudrais remplacer par quelques chose de plus rapide, si cela est possible.



Voici donc la procédure en question

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
Sub copie_noproduit_ancienne_longue_et_mandat()
 
Dim x As Long
Dim cell As Variant
Dim LettreVoulue As String
LettreVoulue = TrouveLettreColonne([no_item_travail])
 
On Error GoTo errohandler:
 
Application.ScreenUpdating = False
 
Sheets("Travail").Select
 
For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
        x = x + 1
 
'nettoyer les no d'item
 
    Sheets("Travail").Cells(x + 1, [no_item_travail].Column) = _
    StripAccent(UCase(CleanTrim(Sheets("Travail").Cells(x + 1, [no_item_travail].Column).value)))
 
 
'recherche et copie de l'ancienne provinciale longue
 
    Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column) = Application.VLookup(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("catalogue").Range("A1").CurrentRegion, 3, False)
 
 
'recherche et copie du no produit
 
    Sheets("Travail").Cells(x + 1, [no_produit_travail].Column) = Application.VLookup(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("catalogue").Range("A1").CurrentRegion, 2, False)
 
 
'recherche et copie mandat
 
    Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("mandat").Range("A1").CurrentRegion, 2)
 
 
    Next cell
 
Application.ScreenUpdating = True
 
Exit Sub
 
errohandler:
 
Application.ScreenUpdating = True
MsgBox "erreur sur la ligne " & x + 1, vbCritical
 
End Sub

DOnt celle-ci contient les procédures et/ou fontions suivantes :

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
 
Public Function TrouveLettreColonne(ByVal ColonneCherche As Range) As String
 
TrouveLettreColonne = Split(Columns(ColonneCherche.Column).Address(ColumnAbsolute:=False), ":")(1)
 
End Function
 
Public Function LastLignUsedInColumn(NomColumn As String)
 
LastLignUsedInColumn = Range(NomColumn & Rows.Count).End(xlUp).Row
 
End Function
 
Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
 
    Dim x As Long, CodesToClean As Variant
 
    CodesToClean = Array(0, 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, 127, 129, 141, 143, 144, 157)
 
    If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), " ")
 
    For x = LBound(CodesToClean) To UBound(CodesToClean)
 
    If InStr(S, Chr(CodesToClean(x))) Then S = Replace(S, Chr(CodesToClean(x)), "")
 
    Next
 
    CleanTrim = WorksheetFunction.Trim(S)
 
End Function
 
Function rmult(valeurachercher As Variant, plageachercher As Range, numcolonne As Long) As Variant
    Dim u As Variant
    Dim nb As Long
    Dim boucle As Long
 
    For boucle = 1 To plageachercher.Rows.Count
 
        If plageachercher(boucle, 1) = valeurachercher Then
            u = u & plageachercher(boucle, numcolonne) & Chr(10)
            nb = nb + 1
        End If
 
    Next boucle
 
    If Right$(u, 1) = Chr(10) Then u = Left$(u, Len(u) - 1)
 
    rmult = u
 
End Function

Cette procédure permet de populer un fichier de travail. Elle fait 2 vlookup afin de populer de l'information pertinente ainsi que la fonction rmult qui est comme un vlookup mais renvoi toute les données possibles contrairement a vlookup qui renvoi seulement le premier trouvé. C'Est à mon avis cette dernière fonction qui ralenti un peu mon processus.


Donc j'ai deux questions sois pouvont nous effectuer cette popuilation de mon fichier en lot ou block au lieu de passé ligne par ligne ??? Si cette dernière n'Est pas possible avez vous une solution afin de rendre plus rapide la fonction rmult ???




merci d'avance pour le temps consacrer a m'aider, c'est plus qu'apprécié !!!

amicalement JP

[marot_r]

Bonjour.

Il est très possible que LastLignUsedInColumn(LettreVoulue) soit exécuté pour chacune des lignes donc si il ne change pas je te suggère :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
dim derniereLigne as long: dernierLigne=LastLignUsedInColumn(LettreVoulue)
...
For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & lastLine)

Comme toutes tes données copiées semblent sur la même ligne dans la feuille source, tu pourrais utiliser WorksheetFunction.Match(TaValeur, TaColonneDeRecherhe, 0) pour récupérer le numéro de la ligne dans la source.
Après tu peux simplement copier les données directement de cette ligne plutôt que de faire une recherche à chaque fois.

Si tu n'as pas de sélection par filtre dans ta feuille source, tu pourrais aussi utiliser TaFeuilleSource.TaColonneDeDonnees.Find() qui te retourne la cellule contenant la donnée. Aprèes tu n'as plus qu'à prendre l'offset de cette cellule pour récupérer les données adjacentes.

Enfin tu pourrais peut-être neutraliser les calculs jusqu'à la fin de la procédure.

Au début tu mets Application.Calculation=xlCalculationManual.
et à la fin tu mets Application.Calculation=xlCalculationAutomatic.

Comme cela au lieu de faire tes calculs à chaque modification de la valeur d'une cellule, tu ne les fait qu'une seule fois après toutes les modifs.

A+

[jpvba]

Un gros merci marot_R


c'est vraiment apprécié !!!


J'ai testé en mettant LastLignUsedInColumn(LettreVoulue) comme variable et résultat approximatif meme legerement suppérieur d'une seconde à la procédure de départ

MOn calcul était déjà en mode manuel, donc en mettant également Application.Calculation=xlCalculationManual n'a pas changer dans ma situation mais cela aurais pu etre effectivement un ralentissement pénible


Il me reste les 2 autres possibilités que vous m'avez identifiés a testé, cependant a titre indicatif ma donnée cherché est dans la feuille Travail colonne C. Mes données auquel je trouve l'information sont dans la colonne C et E, donc non contigüe.

Si je comprends bien, je ne peut utiliser l'option de la copie de ligne complete étant donné ce fais ?


L'option TaFeuilleSource.TaColonneDeDonnees.Find() semble celle qui selon moi pourrais me gagner du temps.


Je vais donc la tester et vous revenir si j'ai un gain en vitesse.


merci encore une fois pour votre coup de pouce !!!!!

[RyuAutodidacte]

Bonjour ,

Tu peux toujours utiliser une feuille tampon avec un filtre élaboré qui te permettra d'afficher toutes les lignes trouvées et seulement les colonnes C et E
on l'avait déjà vu

=> les explications si besoin : Les filtres avancés ou élaborés dans Excel

et là c'est très rapide

[jpvba]

Super Ryu,


Je vais essayer les filtres élaborés après avoir terminé la solution de marot_r que je n'ai pas encore eu le temps de tester.



Si le filtre élaboré pourrais également remplacer la fonction rmult, là j'aurais le top du top en terme de vitesse


Je vous reviens donc après mes tests !!!


merci encore les amis

[jpvba]

Bonjour a vous,


J'ai finalement décidé d'essayé en premier la solution de Ryu et je n'ai malheureusement aucun gain de vitesse . , j'ai environ le meme résultat

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
Sub test_copie_Filtre()
 
Dim x As Long
Dim cell As Variant
Dim LettreVoulue As String
LettreVoulue = TrouveLettreColonne([no_item_travail])
 
 
Dim start As Single
Dim finish As Single
 
 
start = Timer
 
 
 
On Error GoTo errohandler:
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
If sheetExists("filtre") Then Sheets("filtre").Delete
 
 
'_______________________________________________________
 
Sheets.Add.Name = "filtre"
 
Sheets("filtre").Range("a1") = Sheets("catalogue").Range("a1")
Sheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet_Column("Travail", LettreVoulue)).Copy Sheets("filtre").Range("a2")
 
 
Sheets("filtre").Range("d1") = Sheets("catalogue").Range("b1")
Sheets("filtre").Range("e1") = Sheets("catalogue").Range("c1")
 
 
 
'on nomme la plage filtration afin de facilité le code
 
    Sheets("filtre").Range("a2").CurrentRegion.Name = "item_filtre"
 
'on nomme la plage de destination afin de facilité le code
 
    Sheets("filtre").Range("d2").CurrentRegion.Name = "destination"
 
'on nomme la plage de départ afin de facilité le code
 
    Sheets("catalogue").Range("d2").CurrentRegion.Name = "depart"
 
 
Sheets("catalogue").[depart].AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=[item_filtre], CopyToRange:=[Destination], _
        Unique:=True
 
 
Sheets("filtre").Range("d2:d" & LastLignUsedInSheet("filtre")).Copy _
Sheets("Travail").Range(TrouveLettreColonne([no_produit_travail]) & 2)
 
 
Sheets("filtre").Range("e2:e" & LastLignUsedInSheet("filtre")).Copy _
Sheets("Travail").Range(TrouveLettreColonne([ancienne_prov_longue]) & 2)
 
Sheets("filtre").Delete
 
'_______________________________________________________
 
 
Sheets("Travail").Select
 
For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
        x = x + 1
 
'nettoyer les no d'item
 
    Sheets("Travail").Cells(x + 1, [no_item_travail].Column) = _
    StripAccent(UCase(CleanTrim(Sheets("Travail").Cells(x + 1, [no_item_travail].Column).value)))
 
 
 
 
'recherche et copie mandat
 
    Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("mandat").Range("A1").CurrentRegion, 2)
 
 
    Next cell
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
finish = Timer
MsgBox "durée du traitement: " & finish - start & " secondes"
 
 
Exit Sub
 
errohandler:
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "erreur sur la ligne " & x + 1, vbCritical
 
End Sub

Il me reste la dernière option de marot_r, sinon c'est mon code de départ ...

[barpasc]

Si les données sont triées, ça devrait aller beaucoup plus vite… dernier argument de recherchev VRAI ou 1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Application.VLookup(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("catalogue").Range("A1").CurrentRegion, 2, False)

deviendrait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Application.VLookup(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("catalogue").Range("A1").CurrentRegion, 2, True)

[jpvba]

Bonjour barpasc,


merci pour ton temps a vouloir m'aider, c'est très apprécié !!!


Les données de la plage de recherche sont trié, par défaut pour qu'une recherchev ou vlookup fonctionne les données doivent être triés. Le dernier argument est pour avoir une valeur exact ou approximative (valeur_proche) ... J'ai fait un test et comme je croyais aucune amélioration de vitesse

[jpvba]

Bonjour à vous,


Je suis en train d'essayé la solution de marot_r TaFeuilleSource.TaColonneDeDonnees.Find()

JE traduis cette explication en ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column) = _
    Sheets("Travail").Cells(x + 1, [no_item_travail].Column).Find(Sheets("catalogue")).Offset(2, 0).value

cependant j'arrive avec un erreur

J'ai donc regarder sur internet la method range.find


la synthax devrais etre expression.Find (What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)


Donc si j'inverse la logique, j'Arrive à ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column) = _
    Sheets("catalogue").Range("a2:a" & LastLignUsedInSheet("catalogue")) _
    .Find(Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column)).Offset(2, 0).value

Toujours avec un erreur


Est-ce que vous pouvez m'aiguiller car l'explication de microsoft n'Est pas assez l'impide afin que je puisse essayer cette avenue???



merci encore !!!


edit 1 : J'ai réussi a appliquer la method find



J'arrive donc au code suivant

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
Sub test_trouve()
 
Dim x As Long
Dim cell As Variant
Dim LettreVoulue As String
LettreVoulue = TrouveLettreColonne([no_item_travail])
 
 
Dim start As Single
Dim finish As Single
 
 
start = Timer
 
 
 
On Error GoTo errohandler:
 
Application.ScreenUpdating = False
 
Sheets("Travail").Select
 
For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
        x = x + 1
 
'nettoyer les no d'item
 
    Sheets("Travail").Cells(x + 1, [no_item_travail].Column) = _
    StripAccent(UCase(CleanTrim(Sheets("Travail").Cells(x + 1, [no_item_travail].Column).value)))
 
 
'recherche et copie de l'ancienne provinciale longue
 
 
    Sheets("Travail").Cells(x + 1, [ancienne_prov_longue].Column) = _
    Sheets("catalogue").Range("a2:a" & LastLignUsedInSheet("catalogue")) _
    .Find(Sheets("Travail").Cells(x + 1, [no_item_travail].Column)).Offset(0, 2).value
 
 
 
 
 
 
'recherche et copie du no produit
 
    Sheets("Travail").Cells(x + 1, [no_produit_travail].Column) = _
    Sheets("catalogue").Range("a2:a" & LastLignUsedInSheet("catalogue")) _
    .Find(Sheets("Travail").Cells(x + 1, [no_item_travail].Column)).Offset(0, 1)
 
 
'recherche et copie mandat
 
    Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("mandat").Range("A1").CurrentRegion, 2)
 
 
    Next cell
 
Application.ScreenUpdating = True
 
 
finish = Timer
MsgBox "durée du traitement: " & finish - start & " secondes"
 
 
Exit Sub
 
errohandler:
 
Application.ScreenUpdating = True
MsgBox "erreur sur la ligne " & x + 1, vbCritical
 
End Sub

J'arrive donc à la meme vitesse que les autres code antérieurs ainsi à mon code d'origine ...



JE suis vraiment embêté ...

[barpasc]

Bonjour barpasc,


merci pour ton temps a vouloir m'aider, c'est très apprécié !!!


Les données de la plage de recherche sont trié, par défaut pour qu'une recherchev ou vlookup fonctionne les données doivent être triés. Le dernier argument est pour avoir une valeur exact ou approximative (valeur_proche) ... J'ai fait un test et comme je croyais aucune amélioration de vitesse

Bonjour,

RECHERCHEV fonctionne même avec des données non triées. Selon le dernier argument, il renverra une valeur exacte (FAUX) ou une valeur proche (VRAI) mais pas d'erreur bloquante.

Une version encore plus optimisée de RECHERCHEV

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(RECHERCHEV(Val_cherchee;Tableau1;1;1)=val_cherchee;RECHERCHEV(Val_cherchee;Tableau1;2;1);NA())

Des données triées sur la colonne du recherchev est déjà un facteur d'optimisation pour n'importe quelle fonction, script, programme ou même dans une base de données.

Dans le cas où les données ne sont pas triées, il faut trouver un algorithme qui limite l'usage des objets de l'application qui peuvent ralentir le script. Si les fonctions sont entre plusieurs feuilles, ça peut ralentir le script.

Vous pouvez passer toutes vos données (ou une partie des données) dans des tableaux en mémoire et ça sera plus rapide (ça évitera les allers retours entre plusieurs feuilles ce qui n'est pas du tout un gain de temps). Je ne code plus dans mon temps libre parce que j'ai finis d'apprendre mais l'utilisation d'un tableau en mémoire serait à mon avis un premier départ. Il peut y avoir d'autres façons de faire.

Bon courage

[jpvba]

Merci barpasc,

vraiment intéressant votre commentaire !!!


JE sais dans le passé la fonction de base recherchev avais parfois des lacune de traitment lorsque les données n'étaient pas triées. Effectivement parfois cela marchais mais parfois non.


Je suis toujours à la pêche d'autre solution, idée pour mon problème et en espérant trouver une solution. Personnellement je sais que c'Est ma fameuse rmult qui ralenti mais l'information obtenu est vitale pour mon besoins.


DOnc si quelqu'un a une idée, je suis preneur !!!

[jpvba]

Bonjour a vous,


Je crois que je vais clore se post.


Étant donné que je crois que je devrais cibler a optimiser la fonction rmult, qui est le boulet de mon code.


Donc je vais ré ouvrir un autre post ciblant celle-ci.



merci beaucoup pour vos idées, votre temps


c'Est plus qu'apprécié !!!


amicalement JP

[jpvba]

Bonjour a vous,


JE crois qu'il est pertinent d'ajouter une petite mise a jour, étant donné que ce matin grâce au conseil de Ryu dans sa réponse a ce post.



J'ai fais un filtre élaboré dans mon endroit de recherche et je gagne énormément du temps.


Je passe a quelque chose de vraiment terrible a quelque-chose de très très viable

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
Sub test_filtre_FINALE()
 
Dim x As Long
Dim cell As Variant
Dim LettreVoulue As String
Dim item_saisie As Range
LettreVoulue = TrouveLettreColonne([no_item_travail])
 
Set item_saisie = Range(TrouveLettreColonne([no_item_travail]) & 2, TrouveLettreColonne([no_item_travail]) & LastLignUsedInColumn(LettreVoulue))
 
Dim start As Single
Dim finish As Single
 
 
start = Timer
 
 
 
'On Error GoTo errohandler:
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'nettoyer la colonne no d'item
CleanTrim (item_saisie.Select)
 
'si la feuille filtre existe, la détruire
 
If sheetExists("filtre_catalogue") Then Sheets("filtre_catalogue").Delete
If sheetExists("filtre_mandat") Then Sheets("filtre_mandat").Delete
 
 
'créé la feuille filtre pour catalogue
Sheets.Add.Name = "filtre_catalogue"
 
 
Sheets("filtre_catalogue").Range("a1") = Sheets("catalogue").Range("a1")
Sheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet_Column("Travail", LettreVoulue)).Copy Sheets("filtre_catalogue").Range("a2")
 
 
Sheets("filtre_catalogue").Range("d1") = Sheets("catalogue").Range("b1")
Sheets("filtre_catalogue").Range("e1") = Sheets("catalogue").Range("c1")
 
 
 
'on nomme la plage filtration afin de facilité le code
 
    Sheets("filtre_catalogue").Range("a2").CurrentRegion.Name = "item_filtre_catalogue"
 
'on nomme la plage de destination afin de facilité le code
 
    Sheets("filtre_catalogue").Range("d2").CurrentRegion.Name = "destination_catalogue"
 
'on nomme la plage de départ afin de facilité le code
 
    Sheets("catalogue").Range("d2").CurrentRegion.Name = "depart_catalogue"
 
 
Sheets("catalogue").[depart_catalogue].AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=[item_filtre_catalogue], CopyToRange:=[destination_catalogue], _
        Unique:=True
 
 
Sheets("filtre_catalogue").Range("d2:d" & LastLignUsedInSheet("filtre_catalogue")).Copy _
Sheets("Travail").Range(TrouveLettreColonne([no_produit_travail]) & 2)
 
 
Sheets("filtre_catalogue").Range("e2:e" & LastLignUsedInSheet("filtre_catalogue")).Copy _
Sheets("Travail").Range(TrouveLettreColonne([ancienne_prov_longue]) & 2)
 
'on détruit la feuille filtre_catalogue
Sheets("filtre_catalogue").Delete
 
 
'créé la feuille filtre pour le mandat
Sheets.Add.Name = "filtre_mandat"
 
Sheets("filtre_mandat").Range("a1") = Sheets("catalogue").Range("a1")
Sheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInSheet_Column("Travail", LettreVoulue)).Copy Sheets("filtre_mandat").Range("a2")
 
 
Sheets("filtre_mandat").Range("c1") = Sheets("mandat").Range("a1")
Sheets("filtre_mandat").Range("d1") = Sheets("mandat").Range("b1")
 
 
 
'on nomme la plage filtration afin de facilité le code
 
    Sheets("filtre_mandat").Range("a2").CurrentRegion.Name = "item_filtre_mandat"
 
'on nomme la plage de destination afin de facilité le code
 
    Sheets("filtre_mandat").Range("d2").CurrentRegion.Name = "destination_mandat"
 
'on nomme la plage de départ afin de facilité le code
 
    Sheets("mandat").Range("d2").CurrentRegion.Name = "depart_mandat"
 
 
Sheets("mandat").[depart_mandat].AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=[item_filtre_mandat], CopyToRange:=[destination_mandat], _
        Unique:=False
 
 
Sheets("Travail").Select
 
For Each cell In Worksheets("Travail").Range(LettreVoulue & 2, LettreVoulue & LastLignUsedInColumn(LettreVoulue))
 
        x = x + 1
 
 
'recherche et copie mandat
 
    Sheets("Travail").Cells(x + 1, [mandat_lac].Column) = rmult(Sheets("Travail").Cells _
    (x + 1, [no_item_travail].Column), _
    Worksheets("filtre_mandat").Range("c1").CurrentRegion, 2)
 
  Next cell
 
 
'on détruit la feuille filtre_mandat
Sheets("filtre_mandat").Delete
 
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
finish = Timer
MsgBox "durée du traitement: " & finish - start & " secondes"
 
 
Exit Sub
 
errohandler:
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "erreur sur la ligne " & x + 1, vbCritical
 
End Sub

merci encore une fois pour votre aide !!!!

[Soh kamte takam Deni]

Svp l'algorithme dus tris rapide