Appliquer une macro

Bonjour

Voici mon code :

Sub commentaires_notes()
    'Variables
    Dim code As Long, valeur As String
    code = Range("Extraction_PayByPhone!B2")

    'Commentaire en fonction de la note
    Select Case code    ' <= la valeur à tester (ici, le code)
        Case Is = 69101
            valeur = "V1"
        Case Is = 69102
            valeur = "V2 "
        Case Is = 69103
            valeur = "V3"
        Case Is = 69110
            valeur = "Rj"
        Case Is = (69140 = 15)
            valeur = "Rn"
        Case Is = (69140 = 10)
            valeur = "RnTC"
        Case Is = (69140 = 150)
            valeur = "Ra"
        Case Is = (69140 = 100)
            valeur = "RaTC"
        Case Else           ' <= si la valeur n'est égale à aucune des valeurs ci-dessus
            valeur = "Aucun résultat"
    End Select

    'Commentaire en M2
    Range("M2") = valeur
End Sub

il s'applique uniquement pour la 1ère ligne. Je voudrais qu'il s'applique pour toutes les lignes suivantes lorsque mon tableau evolue.

Merci

Bonjour Quattro et bienvenu, bonjour le forum,

Essaie avec ce code (événementielle Change) à placer dans l'onglet Extraction_PayByPhone :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim code As Long, valeur As String

If Target.Column <> 2 Or Target.Row = 1 Then Exit Sub 'si le changement a lieu ailleurs que dans la colonne 2 (=B) ou dans la ligne 1, sort de la procédure
code = Target.Value 'définit la variable code
'Commentaire en fonction de la note
Select Case code    ' <= la valeur à tester (ici, le code)
    Case Is = 69101
        valeur = "V1"
    Case Is = 69102
        valeur = "V2 "
    Case Is = 69103
        valeur = "V3"
    Case Is = 69110
        valeur = "Rj"
    Case Is = (69140 = 15)
        valeur = "Rn"
    Case Is = (69140 = 10)
        valeur = "RnTC"
    Case Is = (69140 = 150)
        valeur = "Ra"
    Case Is = (69140 = 100)
        valeur = "RaTC"
    Case Else           ' <= si la valeur n'est égale à aucune des valeurs ci-dessus
        valeur = "Aucun résultat"
End Select
Target.Offset(0, 11).Value = valeur 'renvoie la variable valeur dans la celluel modifiée décalée de 11 colonnes
End Sub

Bonjour a adapter et essayer

Sub commentaires_notes()
    'Variables
    Dim code As Long, valeur As String
    Dim der_ligne As Long, x as Long

    code = Range("Extraction_PayByPhone!B2")
    der_ligne = Worksheets("Feuil1").Cells.SpecialCells(xlCellTypeLastCell).Row ' récupération de la dernière ligne utilisée sur l'onglet feuil1

For x = 1 To der_ligne    'utilisation de la macro pour la ligne 1 jusqu'à la dernière ligne de l'onglet

    'Commentaire en fonction de la note
    Select Case code    ' <= la valeur à tester (ici, le code)
        Case Is = 69101
            valeur = "V1"
        Case Is = 69102
            valeur = "V2 "
        Case Is = 69103
            valeur = "V3"
        Case Is = 69110
            valeur = "Rj"
        Case Is = (69140 = 15)
            valeur = "Rn"
        Case Is = (69140 = 10)
            valeur = "RnTC"
        Case Is = (69140 = 150)
            valeur = "Ra"
        Case Is = (69140 = 100)
            valeur = "RaTC"
        Case Else           ' <= si la valeur n'est égale à aucune des valeurs ci-dessus
            valeur = "Aucun résultat"
    End Select

    'Commentaire en M2
    Range("M" & x ) = valeur
Next x    'ligne suivante

End Sub

Avec un fichier pour vérifier si ça fonctionne ce serait plus simple pour moi

Cordialement

Bonjour quattro, Bonjour jonyboy et ThauThème

• structure tes données en tableau
• mets un formule directe avec RECHERCHEV(____,VRAI) et elle s'appliquera aux nouvelles lignes

et mets un fichier pour avoir une solution sur excel

Merci

ci joint le fichier.

En fait je veux la meme chose que la colonne "i". Car la colonne "i" la formule est trop lourde.

J'ai oublié, colonne 'i' dans l'onglet "feuil1"

Re,

Le code proposé appliqué à ton fichier...

Bonjour,

formule plus simple issue de ton programme ... mais dont les bornes ne correspondent pas à celles de la colonne i !

=SIERREUR(RECHERCHEV(Extraction_PayByPhone!B2;$L$1:$M$8;2;0);"Aucun résultat")