Recherche dans une colone de valeur NON EXACTE

Bonjour, novice en VBA, j'ai beau chercher je n'arrive pas a trouver de solutions.

En gros j'ai une liste d'évenements dans mes colonnes A et B, ces événements ne sont pas toujours écrits d'une manière tout le temps identique, mais certains éléments sont repérable en colonne B (C** E**).

Je souhaiterai repérer ces éléments caractérisable, et afficher sur la colone C à coté une information présente sur une autre feuille "info", reliée par ce même élément caractérisable...

En pj un truc un peu plus claire.

j'ai essayeé avec des IF mais c'est super lourd, et surtout, il faut que ce soit EXACTEMENT les mêmes termes, à l'espace près, ce qui n'est pas mon coté systématiquement.

Sub Info_Supp_N1()
'déclaration des variables
    Dim ShOut As Worksheet, ShInfo_Sup As Worksheet
    Dim LigIn As Long

   Set ShOut = Workbooks("Nugelec1_MEP").Worksheets("Nugelec1_MEP")
   Set ShInfo_Sup = Workbooks("Mise en page").Worksheets("Liste def Nugelec 1")

' tableau de correspondance avec indexation des défauts en feuille "info sur défauts"
  ShOut.Activate
   For LigIn = 1 To ShOut.UsedRange.Rows.Count

    If Cells(LigIn, "B").Value = " C00 E00 TEST" Then Cells(LigIn, 4).Value = ShInfo_Sup.Range("C3")
    If Cells(LigIn, 2).Value = " C03 E04 ARMOIRE  C.V.C BLOC" Then Cells(LigIn, 4).Value = ShInfo_Sup.Range("C40")

   Next LigIn
End Sub

Après j'ai essayé avec la fonction find et select case, mais la ca beug...

  Sub Cass()
   Set ShOut = Workbooks("Nugelec1_MEP").Worksheets("Nugelec1_MEP")
   Set ShInfo_Sup = Workbooks("Mise en page").Worksheets("Feuil1")
Dim LigIn As String
  ShOut.Activate
  Range("B1").Activate

     ShOut.Activate
   LigFin = (ShOut.UsedRange.Row - 1 + ShOut.UsedRange.Rows.Count)
   CasFin = (ShInfo_Sup.UsedRange.Row - 1 + ShInfo_Sup.UsedRange.Rows.Count)

For Cas = 1 To CasFin
   For LigIn = 1 To LigFin
  Select Case ShInfo_Sup.Cells(Cas, 1)

    Case "C00 E00"
        Find() 'appel la fonction ci dessous
        ActiveCell.Offset(0, 1).Value = ShInfo_Sup.Range(Cas, 2)

    Case "C00 E01"
        Find()  'appel la fonction ci dessous
        ActiveCell.Offset(0, 1).Value = ShInfo_Sup.Range(Cas, 2)
    Case Else

    End Select
     Next LigIn
    Next Cas
End Sub

Sub Find()
For LigIn = 1 To LigFin
        Cells.Find(What:=i, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
    Next LigIn
End Sub

Merci d'avance pour vos aides ou remarques,

La structures n'est pas importantes, je souhaite juste avoir des macros très simples pour un maximum de compatibilité entre les versions d'excel 2003 et 2007 2010 et meme parfois 2000...

Galere galere

Bonjour

Macro à tester

Option Explicit

Sub Cherche()
Dim J As Long
Dim Cel As Range, Depart As String
Dim F3 As Worksheet

  Set F3 = Sheets("info")
  For J = 1 To F3.Range("A" & Rows.Count).End(xlUp).Row
    Set Cel = Columns("B").Find(what:=Trim(F3.Range("A" & J)), LookIn:=xlValues, lookat:=xlPart)
    If Not Cel Is Nothing Then
      Depart = Cel.Address
      Do
        If InStr(1, Trim(Cel), Trim(F3.Range("A" & J))) = 1 Then
          Cel.Offset(0, 1) = F3.Range("B" & J)
        End If
        Set Cel = Columns("B").FindNext(Cel)
      Loop While Depart <> Cel.Address
    End If
  Next J
End Sub

Salut,

[EDIT encore devancé par Banzai que je salue]

t'as pas besoin d'une macro pour cela, voici une formule qui extrait les 7 1ers caractères de ta cellule et qui affiche ensuite le résultat de cette recherche depuis la feuille info.

=RECHERCHEV(GAUCHE(B1;7);info!$A$1:$B$5;2;FAUX)

par contre, tu as des espaces inutiles en dans tes cellules qu'il faut supprimer pour pouvoir appliquer la formule ci dessus.

Sub try()
Application.ScreenUpdating = False
ActiveCell.CurrentRegion.Select

For Each a In Selection
    a.Value = Trim(a.Value)
Next a
Application.ScreenUpdating = True
End Sub

cette macro te permettra de supprimer tous les espaces inutiles.

Il te suffira de placer le curseur sur n'importe quelle cellule du tableau que tu souhaites traiter.

voir le fichier joint.

Super Merci bcp de votre rapidité, ça marche, il ne me manque plus qu'à essayer sur d'autre ordinateurs pour voir si cela fonctionne toujours...