Macro VBA faire recherche mot clé et afficher le contenu de la cellule

Bonjour

Cette fois ci je veux faire une macro VBA qui me permettra de faire un controle hebdomadaire.

En effet j'aimerai que ma macro me permette de recuperer les données de la colonne "mot clé" dans la premiere feuille (Key_Word) de mon classeur puis les colle dans la deuxieme feuille. Ensuite recherche les mots clé dans la colonne "libellé" et affiche le contenu des cellules contenant ces mots clés dans une colonne

Si possible avoir un bouton (macro) ou je devrais cliquer pour faire ce type de controle

Salut Henri27,

un petit bouton en feuille 'Compare', comme souhaité.

Private Sub cmdGO_Click()
'
Dim iRowB%
'
Application.ScreenUpdating = False
'
Range("B:B").Delete shift:=xlToLeft
Range("B1").Value = "Extract"
Range("B1").Borders.LineStyle = xlContinuous
Range("B1").Interior.ColorIndex = 15
'
For x = 2 To Worksheets("key_Word").Range("A" & Rows.Count).End(xlUp).Row
    For y = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If InStr(Range("A" & y).Value, Worksheets("key_Word").Range("A" & x).Value) > 0 Then
            iRowB = Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("B" & iRowB).Value = Range("A" & y).Value
        End If
    Next
Next
Columns.AutoFit
'
Application.ScreenUpdating = true
'
End Sub

A+

Bonsoir Curili

Merci pour ton retour

j'ai essayé d'adapter ton code a mon fichier sans succes. Deja au niveau des feuilles j'ai pas pu retrouver quoi renvoi a quoi et aussi dans mon fichier y'a un decalage comme sur celui que jai attaché a ce message

STp peux tu jeter un coup d'oeil une fois de plus ?

Merci

Salut henri27,

ton code adapté.

Private Sub cmdGO_Click()
'
Dim iRowB%
'
Application.ScreenUpdating = False
'
Range("C:C").Delete shift:=xlToLeft
Range("C2").Value = "Extract"
Range("C2").Borders.LineStyle = xlContinuous
Range("C2").Interior.ColorIndex = 15
'
For x = 2 To Worksheets("key_Word").Range("A" & Rows.Count).End(xlUp).Row
    For y = 2 To Range("B" & Rows.Count).End(xlUp).Row
        If InStr(Range("B" & y).Value, Worksheets("key_Word").Range("A" & x).Value) > 0 Then
            iRowB = Range("C" & Rows.Count).End(xlUp).Row + 1
            Range("C" & iRowB).Value = Range("B" & y).Value
        End If
    Next
Next
Columns.AutoFit
'
Application.ScreenUpdating = True
'
End Sub

A+

Sur la ligne « if Instr »

J’ai une erreur de compilation qui affiche « l’indice n’appartient pas à la sélection »

Comment gérer ça ?

Merci