Copie automatiquement des couleurs

Bonsoir ,

je souhaite faire des copies automatique de cellules en couleur d'une colonne dans une autre colonne et aussi faire un calcul (somme) automatique de cellules d'une sorte de couleur.

merci pour votre aide

VOIR FICHIER CI-JOINT

Bonsoir,

Dans le module de la feuille :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range("B3:B11")) Is Nothing Then
        Target.Offset(, 2).Interior.Color = Target.Interior.Color
        Me.Calculate
    End If
End Sub

Dans un module Standard :

Function SOMROUGE(plg As Range)
    Dim S, c As Range
    Application.Volatile
    For Each c In plg
        If c.Interior.Color = vbRed Then
            If IsNumeric(c) Then S = S + c.Value
        End If
    Next c
    SOMROUGE = S
End Function

Fonction utilisée en D15.

Cordialement.

NB- En l'état, si tu changes une couleur, il faut ensuite revenir sur la cellule modifiée pour déclencher la mise à jour.

Un changement de couleur ne déclenchant en lui-même aucun évènement.

Merci MFerrand pour ton aide

bonne soirée

re

j'ai testé et je ne comprends pas la somme en D15 =9 car je n'ai que 2 celllules rouge en colonne B donc en D15 =2 logiquement

merci de corriger si possible

pouvez-vous m'aider au sujet de la somme comme indiqué au dessus la somme doit etre de 2 et non 9

merci

il y a 2 cellules rouges, avec 2 et 7, la somme fair bien 9 !

Bonjour,

Je me suis mal exprimé hier soir . c'est pas la somme que je veux avoir mais le nombre de cellules rouges dans la colonne donc dans l'exemple c'est 2.

Voilà merci

Changement de fonction :

Function NBROUGE(plg As Range)
    Dim N%, c As Range
    Application.Volatile
    For Each c In plg
        If c.Interior.Color = vbRed Then
            If Not IsEmpty(c) <> "" Then N = N + 1
        End If
    Next c
    NBROUGE = N
End Function

Elle ne compte que les cellules rouges non vides (puisqu'en % ensuite tu l'établis par rapport aux cellules non vides).

Cordialement.