Copier cellules en fonction d'une partie de cette dernière

bonjour, j'aimerais avoir si possible un code vba

qui me copierait les celulles de la "feuil1" vers la feuille active et qui pour point de comparaison chercherait la correspondance entre les deux premiers tirets - des cellules de la feuil1 chercherait dans la feuil2 ou se trouvent ces mots dans la colonne "A" et recopierait les cellules de la colonne "A" de la feuil 1vers les celulles de la colonne "A" de la feuil2

je vous joins un fichier dans la feuil1 les données à copier dans la feuil 2 les données à transformer et dans la feuil3 le résultat espéré

je vous souhaite à tous une bonne journée

Jacques

Bonjour

Ci joint ma solution

A+ François

Bonjour Berjac,

Si une solution sans macro peut aussi te convenir, voici une autre proposition (voir Feuil4).

Cdlt,

Cylfo

Bonjour à tous ,

Une autre version. Les résultats sont sur la feuille "Result".

Cliquer sur le bouton Hop! de la feuille "Result".

Le code dans module1 :

Sub Test()
Dim der&, t, v, i&, k&
   With Sheets("Feuil1")
      der = Application.Max(Application.IfError(Application.Match(9 ^ 99, .Columns(1)), 0), Application.IfError(Application.Match(String(255, "z"), .Columns(1)), 0))
      t = .Range("A1:A" & der)
   End With
   With Sheets("Feuil2")
      der = Application.Max(Application.IfError(Application.Match(9 ^ 99, .Columns(1)), 0), Application.IfError(Application.Match(String(255, "z"), .Columns(1)), 0))
      v = .Range("A1:F" & der)
   End With
   For i = 1 To UBound(v)
      v(i, 1) = Trim(v(i, 1))
      If v(i, 1) <> "" Then
         'v(i, 1) = LCase(Replace(v(i, 1), " ", ""))
         For k = 1 To UBound(t)
            If LCase(t(k, 1)) Like "*" & LCase(v(i, 1)) & "*" Then
               v(i, 1) = t(k, 1): Exit For
            End If
         Next k
      End If
   Next i
   With Sheets("Result")
      .Columns("a:f").Clear
      .Range("A1").Resize(UBound(v), UBound(v, 2)) = v
      .Range("A:F").EntireColumn.AutoFit
   End With
End Sub

Bonjour François et merçi de ton aide

j'ai un souci à la ligne "Set c = .Find(Trim(a(1)), LookIn:=xlValues, lookat:=xlWhole)"

j'ai transposé la macro dans mon classeur de macro mais avec un autre fichier similaire elle ne fonctionne pas

merçi

Jacques

Un grand merçi à tous , François , Mafraise et Cyflo ,

je garde la solution de Mafrais qui pour moi est la plus aisée merçi à tous je ferme le sujet

bonne journée

Jacques