Repport d'une liste dans plusieurs tableau

[Cow18]

exactement un mot ou une chaîne de charactères```
Sub teste()

 If InStr(1, Range("A1").Value, "dedans", 1) > 0 Then     'chercher "dedans"
      Range("A2").Value = "oui, dedans"
 End If

 If InStr(1, Range("A1").Value, "essag", 1) > 0 Then     ' chercher essag (part de message)
      Range("A3").Value = "oui, essag"
 End If

End Sub

[Angel_Bzh.xlsm|attachment](upload://m4HQ0nOQc8ElcgMyaLEfueMKMUb.xlsm) (13,4 Ko)

[Angel_bzh]

Je n’ai pas réussi à télécharger ton fichier
J’ai voulu essayer chatGPT pour réaliser la même chose, mais également supprimer le contenu de la plage avant dans le cas où les données auraient changé depuis la dernière exécution.
Je voudrais ton avis vu que tu maîtrises le sujet
Testemacrorecherche.xlsm (17,5 Ko)

[Cow18]

c’est bien fait, mais si vous sera plus évolué, peut-être que vous ne déclarez plus tout les choses. Ceci est un début, mais le fonctionnement est pareil

Sub RechercherEtEcrire2()

     Dim rng   As Range
     Dim cell  As Range

     ' Spécifiez le nom de votre feuille de calcul (worksheet) ici
     Set rng = ThisWorkbook.Worksheets("Feuil1").Range("B4:B12")     'vos données
     ' Supprime les cellules 2 colonnes a droite de vos données
     rng.Offset(, 2).ClearContents

     ' Parcourez chaque cellule dans la plage spécifiée
     For Each cell In rng.Cells
          If InStr(1, cell.Value, "dedans", vbTextCompare) > 0 Then
               ' Si le mot "dedans" est trouvé, écrivez "Trouver" dans la colonne D sur la même ligne
               cell.Offset(, 2).Value = "Trouver"     'la cellule 2 colonnes à droite de "cell"
          ElseIf InStr(1, cell.Value, "ici", vbTextCompare) > 0 Then
               ' Si le mot "ici" est trouvé, écrivez "il est là" dans la colonne D sur la même ligne
               cell.Offset(, 2).Value = "il est là"
          End If
     Next cell
End Sub

[Cow18]

Sub RechercherEtEcrire2()

     Dim Rng   As Range, Cell As Range

     Set Rng = ThisWorkbook.Worksheets("Feuil1").Range("B4:B12")     'vos données
     Rng.Offset(, 2).ClearContents           'RAZ plage à côté


     For Each Cell In Rng.Cells              ' Parcourez chaque cellule dans la plage spécifiée
          If InStr(1, Cell.Value, "dedans", vbTextCompare) > 0 Then Cell.Offset(, 2).Value = "Trouver"     'la cellule 2 colonnes à droite de "cell"
          If InStr(1, Cell.Value, "ici", vbTextCompare) > 0 Then Cell.Offset(, 2).Value = Cell.Offset(, 2).Value & IIf(Cell.Offset(, 2).Value <> "", " ", "") & "il est là"
     Next Cell

End Sub```
remarque : 
* maintenant il détecte en même temps "dedans" et "ici"
* si vous donnez vos variables un majuscule dans leur déclaration, vous verrez cela plus loin dans la macro et cela peut vous aider à éliminer des erreurs d'écriture ...