Macro colorer cellule

Bonjour,

code a copier dans VBA de la feuille:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A2:A" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("A2:A" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(1), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart

            For N = 1 To Nb
                lig = Columns(1).Find(Cel, Cells(lig, 1), , xlWhole).Row
                If Cells(lig, 1).Interior.Color = vbGreen Then
                    Cells(lig, 1).Interior.Pattern = xlNone
                Else
                    Cells(lig, 1).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne A pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A2:A" & derlig)) Is Nothing Then
        Cancel = True
        Range("A2:A" & derlig).Interior.Pattern = xlNone
    End If
End Sub

Pour ouvrir la fenetre VBA, appuyez sur touches alt+F11, double clic sur la feuille en haut a gauche, copier/coller le code et essayez

Alors après recherche j'ai réussis à inserer mon code... Le probleme c'est qu'il marche pour la colonne A uniquement. Je le voudrais si possible sur la L

Bonjour,

Colonne L

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("L2:L" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(12), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart

            For N = 1 To Nb
                lig = Columns(12).Find(Cel, Cells(lig, 12), , xlWhole).Row
                If Cells(lig, 12).Interior.Color = vbGreen Then
                    Cells(lig, 12).Interior.Pattern = xlNone
                Else
                    Cells(lig, 12).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne A pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Range("L2:L" & derlig).Interior.Pattern = xlNone
    End If
End Sub

Merci beaucoup d'avoir pris le temps de répondre à ce post, c'est très gentil. Toutefois si vous accepté de prendre encore quelque minutes pour compléter cette macro ce serai vraiment sympathique. je m'explique :
Tous les prénoms sont recensés (1 fois chacun) dans la colonne Q à partir de la ligne 47 jusqu’à infinis puisque je remets des prénoms tous les mois.
- Serait-il possible qu'eux se mettent également en couleur via le double clic ? (En synchronisation avec la colonne L)
- Peut-on ajouter une option où aucune cellule n'est coloré (double clic dans la colonne N par exemple)
J'insiste sur le fais que vous m'avez déjà bien aidé (je vous en remercie encore) et que je comprendrais que vous n'ayez pas envie de résoudre ces 2 petits soucis qu'il me reste.
Bien cordialement,

Bonjour,

Ok, mais
- Peut-on ajouter une option où aucune cellule n'est coloré (double clic dans la colonne N par exemple)
Vous avez deja le clic droit sur colonne L!!!!!!!!!!!!!!!!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("L2:L" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(12), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart
            For N = 1 To Nb
                lig = Columns(12).Find(Cel, Cells(lig, 12), , xlWhole).Row
                If Cells(lig, 12).Interior.Color = vbGreen Then
                    Cells(lig, 12).Interior.Pattern = xlNone
                Else
                    Cells(lig, 12).Interior.Color = vbGreen
                End If
            Next N
        End If
        derlig = Range("Q" & Rows.Count).End(xlUp).Row
        Range("Q47:Q" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(17), Cel)
        If Nb > 0 Then
            lig = 47 'ligne de depart
            For N = 1 To Nb
                lig = Columns(17).Find(Cel, Cells(lig, 17), , xlWhole).Row
                If Cells(lig, 17).Interior.Color = vbGreen Then
                    Cells(lig, 17).Interior.Pattern = xlNone
                Else
                    Cells(lig, 17).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne Q et L pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derligL = Range("L" & Rows.Count).End(xlUp).Row
    derligQ = Range("Q" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Range("L2:L" & derligL).Interior.Pattern = xlNone
        Range("Q47:Q" & derligQ).Interior.Pattern = xlNone
    End If
End Sub