Recherche données multiples dans un tableau

Bonjour à tous,

Je suis novice en VBA et suis confrontée à un petit problème.

J'aimerai créer une macro qui me permette à partir des cellules B24 à B47 de retrouver dans une tableau les valeurs et me sélectionner les lignes où se trouvent ces valeurs. (J'espère que mon explication est compréhensible)

J'ai trouvé ce code en cherchant sur le net et je l'ai adapté à mon classeur.

Il fonctionne très bien pour la cellule sélectionnée, mais j'aimerai également qu'il tienne compte des cellules suivantes et que toutes les lignes qui contiennent ces valeurs soient selectionnées.

Je vous remercie d'avance pour votre aide!

Sub recherche1()

rngy = Sheets("BL").Range("B24").Value

    Sheets("STOCK").Select
    Columns("c:c").Select
    Cells.find(What:=rngy, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

        ActiveCell.EntireRow.Select

End Sub

Bonjour Mahore

J'ai un petit fichier qui devrait t'aider

A toi de l'adapter

Salut

Bonjour,

Une autre proposition.

Cdlt.

Public Sub SelectRows()
Dim ws As Worksheet, ws2 As Worksheet
Dim Rng As Range, Rng2 As Range, Rng3 As Range, Cell As Range, r As Range
Dim lastRow As Long
Dim firstAddress As String

    Set ws = Worksheets("BL")
    Set Rng = ws.Range("B24:B47")

    Set ws2 = Worksheets("STOCK")
    With ws2
        lastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
        Set Rng2 = .Cells(3).Resize(lastRow)
    End With

    For Each Cell In Rng
        If Not IsEmpty(Cell) Then
            Set r = Rng2.Find(what:=Cell.Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not r Is Nothing Then
                firstAddress = r.Address
                Do
                    If Rng3 Is Nothing Then Set Rng3 = r Else Set Rng3 = Union(Rng3, r)
                    Set r = Rng2.FindNext(r)
                Loop While Not r Is Nothing And r.Address <> firstAddress
            End If
        End If
    Next Cell

    If Not Rng3 Is Nothing Then Rng3.EntireRow.Select

End Sub

Merci à tous les deux pour vos réponses! Cela fonctionne!

Vous me retirez une belle épine du pied! Bonne journée!