Find sur plusieurs colonnes

Version imprimable

Bien le bonjour la communauté,

N'étant pas encore super à l'aise avec VBA je me contente de bricoler des solutions en utilisant des bout de code existant et l'enregistreur. Il se trouve que je rencontre une erreur dans mon code que je n'arrive pas à solutionner.

La philosophie du code est de chercher les données une à une qui se trouvent dans la colonne V de l'onglet Base, dans l'onglet Lieu. Une fois la valeur trouver dans l'onglet Lieu, la macro dans me prendre l'info qui se trouve sur la meme ligne mais en colonne E et me copier l'info dans l'onglet Base en colonne W. Tout se passait bien jusqu'à ce que je tente de gérer les erreurs (valeur non trouvée). Si la valeur n'est pas trouvée je voudrais que la macro m'inscrire N/A en colonne W sur la même ligne que la valeur trouvée. La macro me sort l'erreur 91 au niveau de mon find suite à des valeurs non trouvées

J'espere que j'ai réussi à etre clair, je ne vous joint pas le fichier pour le moment car les données sont confidentielles. Je peux modifier ce qu'il y a dedans si besoin

Voici le code (qui n'est pas très beau)
Code:

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 Macro3() ' Application.ScreenUpdating = False ' Dim I As Long Dim Plage As Range Dim Valeur As Variant Sheets("Base").Select Set Plage = Range("V2:A" & Range("V65536").End(xlUp).Row) For I = 2 To 15 Range(Cells(I, 22), Cells(I, 22)).Select Valeur = Range(Cells(I, 22), Cells(I, 22)).Value Selection.Copy Sheets("Lieu").Select On Error GoTo Suite Cells.Find(What:=Valeur, After:=ActiveCell, LookIn:= _ xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext _ , MatchCase:=False, SearchFormat:=False).Activate On Error GoTo Suite Cells(ActiveCell.Row, "E").Select ActiveCell.Copy Sheets("Base").Select Range(Cells(I, 23), Cells(I, 23)).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False DEBUT: Next GoTo FIN Suite: Sheets("Base").Select Cells(I, 23).Value = "n/a" If I < 1456 Then GoTo DEBUT Else FIN: End Sub
Merci pour votre aide

06/10/2017, 09h09
Marc-L

Bonjour,

vite fait en passant :

• voir donc l'exemple de l'aide VBA interne de cette méthode Find pour gérer en cas de non trouvé.

• La description du besoin me ferait plutôt pencher pour une simple formule de calculs via RECHERCHEV,
et si vraiment besoin d'une procédure alors une unique ligne de code serait nécessaire …

___________________________________________________________________________________________________________
Je suis Paris, Barcelone, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …
06/10/2017, 09h23
dam55555

Avant de poster cette demande de coup de pouce j'ai pris le temps de chercher, et rechercher pour trouver la clé du problème, malheureusement en vain.*

Impossible de faire un recherchev, car j'ai 365 colonnes ou il faut chercher la valeur...

Suite à une utilisation de set je n'ai plus d'erreur, mais je comprends toujours pas pourquoi il bloquait

Code:

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
Sub Macro3()
'
' Macro3 Macro
'
Application.ScreenUpdating = False
'
Dim I As Long
Dim Plage As Range
Dim Valeur As Variant
Dim Trouve As Variant
 
 
    Sheets("Base").Select
 
    Set Plage = Range("V2:A" & Range("V65536").End(xlUp).Row)
 
 
    'For I = Plage.Cells.Count To 1 Step -1
 
 
 
For I = 2 To 2008
 
 
 
 
 
Range(Cells(I, 22), Cells(I, 22)).Select
Valeur = Range(Cells(I, 22), Cells(I, 22)).Value
 
Selection.Copy
 
 
Sheets("Lieu").Select
 
'On Error GoTo Suite
 
Set Trouve = Cells.Find(what:=Valeur, LookAt:=xlWhole)
 
If Trouve Is Nothing Then
 
 
Sheets("Base").Select
Cells(I, 23).Value = "n/a"
 
If I < 2009 Then GoTo DEBUT Else
 
 
Else
 
Cells.Find(what:=Valeur, LookAt:=xlWhole).Activate
 
 
Cells(ActiveCell.Row, "E").Select
 
 
ActiveCell.Copy
 
 
 
Sheets("Base").Select
Range(Cells(I, 23), Cells(I, 23)).Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
End If
 
 
DEBUT:
 
Next
 
 GoTo FIN
 
 
 
 
FIN:
 
 
    End Sub