Bonjour à vous,

Voici un code que j'ai adapté pour effectuer une recherche sur une colonne.

Je cherche a obtenir une recherche sur 2 colonne avec le même code.

Donc recherche sur la colonne K et AA.

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
Sub Recherche()
 
    Dim valeur As Variant
    Dim premiere As Variant
    Dim liste As String
    Dim Aucun As String
    Dim Onglet As String
    Dim Cellule As Range
 
 Do
    valeur = Application.InputBox("Inscrire la donnée rechercher")
 
    'Liste est une chaine de caractères
 
    liste = "Voici ce qui vous sont attribuées :"
 
    'Aucun est une chaine de caractères
 
    Aucun = "Aucune correspondance  " & "[ " & valeur & " ]"
 
   If valeur = False Then
        Exit Sub
    End If
    If valeur = "" Then MsgBox "Vous devez entrer une donnée de recherche!", vbExclamation, "Erreur"
    Loop Until valeur <> ""
    Derlig = Range("K" & Rows.Count).End(xlUp).Row
 
        With Sheets("Résumé").Range("K27:K" & Derlig)      'Plage choisie
            Set Cellule = .Find(valeur, LookIn:=xlValues)
            If Not Cellule Is Nothing Then
                premiere = Cellule.Address
 
                Do
 
                 If Cellule.Offset(-4, -9).Value = "" Then
 
                liste = liste & vbCr & vbCr & Cellule.Offset(-4, -9) & " " & " " & Cellule.Offset(0, -2)
 
               End If
 
                 If Cellule.Offset(-4, -9).Value <> "" Then
 
                liste = liste & vbCr & vbCr & Cellule.Offset(-4, -9) & " " & " " & Cellule.Offset(-1, -2)
 
               End If
 
                    'action a faire dès que la ligne est trouvée
                    Set Cellule = .FindNext(Cellule)
                Loop While Not Cellule Is Nothing And Cellule.Address <> premiere
 
                Else
             MsgBox Aucun, vbInformation, "Résultat"
 
              Exit Sub
            End If
       End With
 
    If Right(liste, 1) <> ":" Then MsgBox liste, vbInformation, "Résultat"
 
Application.CutCopyMode = False
 
End Sub
Merci de votre habituelle collaboration