Bonjour à Tous,
Avec l'aide précieux de Eric KERGRESSE, j'ai réussi à faire une recherche d'un NOM dans ma feuille "BASE" et d'afficher les valeurs dans un formulaire "FICHE". cela fonctionne très bien. Sauf que j'ai des homonymes et du coup le programme affiche le premier trouvé.

Comment faire pour que suite à la première recherche (sur le NOM), le programme teste et cherche sur le PRENOM et si existence affiche?

Merci pour votre aide.

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
Sub FICHERechercheNom(ByVal ChaineARechercher As String, ByVal ShBase As Worksheet, ByVal ShFiches As Worksheet)
 
 
'Utilisation partie code Eric KERGRESSE developpez.com
'
' RECHERCHE nom saisie sur FICHES en D6
' Affichage le resultat dans le formulaire FICHES
'
 
Dim AireRecherche As Range
Dim AireRechercheNom As Range
Dim AireRecherchePre As Range
Dim DerniereLigne As Long, i As Long, Trouve As Long
Dim ColNom As Long, ColPrenom As Long, ColSexe As Long, ColAge As Long, ColPoids As Long, ColTaille As Long, ColEtab As Long, ColGr As Long
Dim ColTEST1 As Integer, ColTEST2 As Integer, ColTEST3 As Integer, ColTEST4 As Integer, ColTEST5 As Integer, ColTEST6 As Integer, ColTEST7 As Integer, ColTEST8 As Integer
Dim RechPre As String
 
Dim ret As Integer 'VAR MSGBOX OUI NON
 
        With Sheets("FICHES") 'charge prenom
           RechPre = Range("G6")
        End With
 
If RechPre = "" Then 'si pas prenom
 
        With ShBase
 
           ColNom = 3: ColPrenom = 4: ColSexe = 5: ColAge = 6: ColPoids = 8: ColTaille = 9: ColEtab = 10: ColGr = 11: ColTEST1 = 14: ColTEST2 = 16: ColTEST3 = 18: ColTEST4 = 20: ColTEST5 = 22: ColTEST6 = 24: ColTEST7 = 26: ColTEST8 = 28
           DerniereLigne = .Range("C1000").End(xlUp).Row
           If DerniereLigne < 3 Then Exit Sub
 
           Set AireRecherche = .Range(.Cells(3, ColNom), .Cells(DerniereLigne, ColNom))
           Set AireRecherchePre = .Range(.Cells(3, ColPrenom), .Cells(DerniereLigne, ColPrenom))
 
           With Sheets("FICHES")
 
           Trouve = 0
           End With
 
           For i = 1 To AireRecherche.Count
               If AireRecherche(i) = ChaineARechercher Then
                 With ShFiches
                 Trouve = 1
 
''''PERSO
                        .Range("D6") = AireRecherche(i)
                        .Range("G6") = AireRecherche(i).Offset(0, ColPrenom - ColNom)
                        .Range("D8") = AireRecherche(i).Offset(0, ColSexe - ColNom)
                        .Range("G8") = AireRecherche(i).Offset(0, ColAge - ColNom)
                        .Range("D10") = AireRecherche(i).Offset(0, ColPoids - ColNom)
                        .Range("G10") = AireRecherche(i).Offset(0, ColTaille - ColNom)
                        .Range("D15") = AireRecherche(i).Offset(0, ColEtab - ColNom)
                        .Range("G15") = AireRecherche(i).Offset(0, ColGr - ColNom)
 
''ETAB
                        .Range("D15") = AireRecherche(i).Offset(0, ColEtab - ColNom)
                        .Range("G15") = AireRecherche(i).Offset(0, ColGr - ColNom)
 
''TESTS
                        .Range("D20") = AireRecherche(i).Offset(0, ColTEST1 - ColNom)
                        .Range("D22") = AireRecherche(i).Offset(0, ColTEST2 - ColNom)
                        .Range("D24") = AireRecherche(i).Offset(0, ColTEST3 - ColNom)
                        .Range("D26") = AireRecherche(i).Offset(0, ColTEST4 - ColNom)
                        .Range("D28") = AireRecherche(i).Offset(0, ColTEST5 - ColNom)
                        .Range("D30") = AireRecherche(i).Offset(0, ColTEST6 - ColNom)
                        .Range("D32") = AireRecherche(i).Offset(0, ColTEST7 - ColNom)
                        .Range("D34") = AireRecherche(i).Offset(0, ColTEST8 - ColNom)
 
 
                  End With
               End If
 
           Next i
           Select Case Trouve
                  Case Is <> 1
                  Range("D6") = ""
                  MsgBox "Le nom " & ChaineARechercher & " n'existe pas!", vbCritical, "RECHERCHE d'un nom"
 
           End Select
 
           Set AireRecherche = Nothing
 
        End With
Else 'si prenom
MsgBox "Il y a un prenom"
'           Set AireRecherche = .Range(.Cells(3, ColPrenom), .Cells(DerniereLigne, ColPrenom))
 
End If
 
End Sub