Macro mot de remplacement

Bonjour,

j'aimerais trouvé une macro qui me renseigne un cellule à partir d'un mot.

En colonne D j'ai des produits et dans un autre onglet j'ai une liste de personnes à qui sont rattaché ces produits.

J'aimerais dans le premier onglet que à chaque fois qu'un produit apparait en colonne C le nom de la personne à qui est rattaché ce produit s'affiche.

merci.

Bonjour,

2 propositions:

la première avec un bouton pour remplir toutes les cellules en une seule fois si les produits sont déjà inscrits

la deuxième, conforme à votre demande, c'est à dire après chaque saisi d'un nouveau produit

Cdlt

Bonjour Arturo83,

merci pour ton retour cela correspond à mes attente mais il y a juste un petit souci.

Certains produits sont en abrégés, serait il possible que la macro tienne compte de l'ensemble de la cellule exemple si dans la cellule j'ai juste POM alors cela tiens compte de POMME?

remplacez cette ligne

            Set x = .Find(Produit, lookat:=xlWhole)

par celle-ci

            Set x = .Find(Produit, lookat:=xlPart)

Cela ne fonctionne pas je met en PJ mon fichier

Correctif:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, i As Long
    Dim x As Range
    Dim Produit As String
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Target.Column = 3 Then
        Set f1 = Sheets("Feuil1")
        Set f2 = Sheets("Liste")
        With f2.Cells
            Set x = .Find(Target, lookat:=xlPart)
            If Not x Is Nothing Then f1.Cells(Target.Row, "B") = f2.Cells(x.Row, "C")
        End With
        Set f1 = Nothing
        Set f2 = Nothing
    End If
Sortie:
    Application.EnableEvents = True
End Sub

Cdlt

Merci mais c'est pas tout a fait ça.

Dans mon fichier "onglet feuil1" cellule C7 il y a marqué "Pomme R" mais dans l'onglet "liste" il y aura juste marqué Pomme et la macro ne fonctionne pas dans ce sens.

D'où l'importance d'être bien précis dans les demandes. Essayez ceci:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, i As Long
    Dim x As Range
    Dim Produit As String
    On Error GoTo Sortie
    Application.EnableEvents = False
    If Target.Column = 3 Then
        Set f1 = Sheets("Feuil1")
        Set f2 = Sheets("Liste")
        Produit = Left(Target, InStr(1, Target, " ") - 1)
        With f2.Cells
            Set x = .Find(Produit, lookat:=xlPart)
            If Not x Is Nothing Then f1.Cells(Target.Row, "B") = f2.Cells(x.Row, "C")
        End With
        Set f1 = Nothing
        Set f2 = Nothing
    End If
Sortie:
    Application.EnableEvents = True
End Sub