Bonjour,

Ma feuille de calculs contient de A1 à A200 une liste de noms et je cherche à ce que mon code sélectionne la dernière cellule dans laquelle le nom que je rentre dans une Input Box se trouve.
Ces noms peuvent, ou non, se répéter plusieurs fois.

Pour l'instant, j'utilise un code qui fonctionne très bien pour trouver la première cellule dans laquelle le nom se trouve et la dérive pour la deuxième occurrence mais il me semble fastidieux de poursuivre ainsi avec un code qui pourrait aller jusqu'à une douzaine d'occurrences.

Le 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
58
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Target.Address = "$A$1" Then
 
 
  Dim Lig As Long, Nom As String, Line As Long, Col As Long, LignSel As Long
 On Error GoTo errorHandler2
Nom = InputBox("Saisie de votre NOM : ", "NOM")
If Nom = "" Then
Exit Sub
Else
errorHandler2:
Dim cel As Range
    If Application.WorksheetFunction.CountIf(Sheets("RECUP").Range("A2:A" & Sheets("RECUP").Range("A65536").End(xlUp).Row), Nom) = 1 Then
MsgBox "OK"
 
Do
    Set cel = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
 
    If Not cel Is Nothing Then cel.Activate
    LignSel = ActiveCell.Row
 
   Exit Sub
    Loop While Not cel Is Nothing
 
End If
 
 
 
    End If
    If Application.WorksheetFunction.CountIf(Sheets("RECUP").Range("A2:A" & Sheets("RECUP").Range("A65536").End(xlUp).Row), Nom) = 2 Then
 
 
 
  Do
    Set cel = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
 
    If Not cel Is Nothing Then cel.Activate
    LignSel = ActiveCell.Row
 
 
 
 
 
    Set cel = Sheets("RECUP").Range("" & "A" & LignSel + 1 & ":A200" & "").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
 
    If Not cel Is Nothing Then cel.Activate
    LignSel = ActiveCell.Row
 
    Exit Sub
    Loop While Not cel Is Nothing
 
  End If
 
 
End If
 
 End Sub

Pour synthétiser, la feuille de calculs:

A1 : Michel
A2: Patrick
A3: Robert
.
.
.

A42: Robert
.
.
.
A105: Robert
.
.
.

Mon code, pour l'instant, fonction très bien pour sélectionner la cellule où se trouve Michel ou Patrick ainsi que Robert en A3 et A42 mais, pour le Robert en A105, il me faudrait encore répéter un:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
Set cel = Sheets("RECUP").Range("" & "A" & LignSel + 1 & ":A200" & "").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
    'MsgBox cel
    If Not cel Is Nothing Then cel.Activate
    LignSel = ActiveCell.Row
A l'intérieur de:

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
Do
    Set cel = Sheets("RECUP").Range("A2:A200").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
 
    If Not cel Is Nothing Then cel.Activate
    LignSel = ActiveCell.Row
 
 
 
 
    Set cel = Sheets("RECUP").Range("" & "A" & LignSel + 1 & ":A200" & "").Find(What:="" & Nom & "", LookAt:=xlWhole, SearchOrder:=xlByColumns)
 
    If Not cel Is Nothing Then cel.Activate
    LignSel = ActiveCell.Row
 
    Exit Sub
    Loop While Not cel Is Nothing
 
  End If
Pour:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Application.WorksheetFunction.CountIf(Sheets("RECUP").Range("A2:A" & Sheets("RECUP").Range("A65536").End(xlUp).Row), Nom) = 3 Then
Et ainsi de suite jusqu'à une bonne douzaine de fois.

Quelqu'un pourrait il m'apporter une aide précieuse?

MERCI D'AVANCE