Mise en couleur d'une cellule liée si modification

Bonjour,

Je consulte très régulièrement votre forum pour trouver des solutions à l'écriture de mes macros et je vous remercie tous ceux qui l'anime car cela m'aide beaucoup.

Après recherche sur le forum, je n'ai pas trouvé réponse à mon problème qui est le suivant :

J'ai un fichier qui comprend 7 onglets (6 départements + 1 synthèse).

Dans l'onglet synthèse, je copie / colle avec liaison des données des 6 autres onglets.

Mon but est que systématiquement quand je modifie une info sur un des 6 onglets départements, la nouvelle info se mette en rouge dans l'onglet synthèse.

J'ai copié cette macro dans la feuille synthèse mais cela ne fonctionne pas

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Target.Value <> "" Then

Target.Interior.ColorIndex = 3

End If

End Sub

Pourriez-vous m'aider SVP ? Je vous remercie.

Bonjour et bienvenue sur le forum

Tu devrais joindre ton fichier….

Bye !

Bonjour,

Je vous mets en PJ le fichier qui va vous permettre, je l'espère, de comprendre ma demande.

Par exemple, si je modifie une information dans l'onglet DEP01 (changer la provenance par exemple), je souhaiterais que la nouvelle info se mette en rouge dans l'onglet SYNTH.

Merci de votre aide.

Cordiales salutations.

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonjour gmb,

Grand Merci d'avoir pris du temps pour m'aider et aussi rapidement.

Boulot remarquable.

Totalement débutante en VBA, je ne comprends pas toutes les subtilités

Me pensant assez "costaude", j'ai voulu retranscrire ta macro dans mon fichier de travail et bingo cela ne fonctionne pas

1- Est-ce que le fait de changer le nom des onglets : par exemple "DEP 01" par "DEP 37" a-t-il une incidence ?

2- Changer le nom de l'onglet "SYNTH" par "PC EC", je pense que cela n'a pas d'incidence

3- j'ai 11 colonnes ("K") et non 5 ("E") ; je pense avoir modifié ce qu'il fallait

Ci-dessous, ce que j'ai retranscrit ; vois-tu où ça pêche ? j'ai supprimé le msgbox (et merci pour la macro supp razcolor).

Y a t-il possibilité de ne voir s'inscrire en rouge que la cellule modifiée et non toute la ligne ?

Merci de ton aide.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Left(ActiveSheet.Name, 3) <> "DEP" Then Exit Sub

tablo = Sheets("PC EC").Range("A1:K" & Sheets("PC EC").Range("A" & Rows.Count).End(xlUp).Row)

If Target.Count > 1 Then Exit Sub

Application.EnableEvents = False

If Not Intersect(Target, Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then

ln = Target.Row

concat = Range("A" & ln) & Range("B" & ln) & Range("C" & ln) & Range("D" & ln) & Range("E" & ln) & Range("F" & ln) & Range("G" & ln) & Range("H" & ln) & Range("I" & ln) & Range("J" & ln) & Range("K" & ln)

tabloP = Range("A" & ln & ":K" & ln)

Application.Undo

concatOr = Range("A" & ln) & Range("B" & ln) & Range("C" & ln) & Range("D" & ln) & Range("E" & ln) & Range("F" & ln) & Range("G" & ln) & Range("H" & ln) & Range("I" & ln) & Range("J" & ln) & Range("K" & ln)

If concat = concatOr Then GoTo fin

Range("A" & ln).Resize(1, 11) = tabloP

flag = 0

For i = 2 To UBound(tablo, 1)

If tablo(i, 1) & tablo(i, 2) & tablo(i, 3) & tablo(i, 4) & tablo(i, 5) & tablo(i, 6) & tablo(i, 7) & tablo(i, 8) & tablo(i, 9) & tablo(i, 10) & tablo(i, 10) = concat Then

Sheets("PC EC").Range("A" & i & ":k" & i).Font.Color = RGB(255, 0, 0)

flag = 1

Exit For

End If

Next i

End If

fin:

Application.EnableEvents = True

End Sub

Shamallow a écrit :

1- Est-ce que le fait de changer le nom des onglets : par exemple "DEP 01" par "DEP 37" a-t-il une incidence ?

2- Changer le nom de l'onglet "SYNTH" par "PC EC", je pense que cela n'a pas d'incidence

3- j'ai 11 colonnes ("K") et non 5 ("E") ; je pense avoir modifié ce qu'il fallait

Aussi, je ne vois pas ce qui cloche, d'autant que j'ai fait fonctionner ton adaptation sur mon PC sans problème.

Y a t-il possibilité de ne voir s'inscrire en rouge que la cellule modifiée et non toute la ligne ?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Left(ActiveSheet.Name, 3) <> "DEP" Then Exit Sub
    tablo = Sheets("PC EC").Range("A1:K" & Sheets("PC EC").Range("A" & Rows.Count).End(xlUp).Row)
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        ln = Target.Row
        col = Target.Column
        concat = Range("A" & ln) & Range("B" & ln) & Range("C" & ln) & Range("D" & ln) & Range("E" & ln) & Range("F" & ln) & Range("G" & ln) & Range("H" & ln) & Range("I" & ln) & Range("J" & ln) & Range("K" & ln)
        tabloP = Range("A" & ln & ":K" & ln)
        Application.Undo
        concatOr = Range("A" & ln) & Range("B" & ln) & Range("C" & ln) & Range("D" & ln) & Range("E" & ln) & Range("F" & ln) & Range("G" & ln) & Range("H" & ln) & Range("I" & ln) & Range("J" & ln) & Range("K" & ln)
        If concat = concatOr Then GoTo fin
        Range("A" & ln).Resize(1, 11) = tabloP
        flag = 0
        For i = 2 To UBound(tablo, 1)
            If tablo(i, 1) & tablo(i, 2) & tablo(i, 3) & tablo(i, 4) & tablo(i, 5) & tablo(i, 6) & tablo(i, 7) & tablo(i, 8) & tablo(i, 9) & tablo(i, 10) & tablo(i, 10) = concat Then
                Sheets("PC EC").Cells(i, col).Font.Color = RGB(255, 0, 0)
                flag = 1
                Exit For
            End If
        Next i

    End If
fin:
    Application.EnableEvents = True
End Sub

Si problème, joint ton nouveau fichier…

Bye !

Bonjour gmb,

Merci pour ta réponse.

Je fais de nouveau un essai sur mon fichier.

Cordialement.

Bonjour gmb,

Je viens de faire un premier essai sur notre fichier d'essai que j'ai mis en PJ

Il s'avère que si toutes les cellules de la ligne ne contiennent pas des infos, la mise en couleur ne s'effectue pas.

trop nulle en VBA pour trouver une solution.

Merci de ton aide.

Cordiales salutations.

Re,

question subsidiaire

J'ai voulu mettre dans la feuille "SYNTH" cette macro :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'met en rouge le nouveau texte

If Target.Value <> "" Then

Target.Font.ColorIndex = 3

End If

End Sub

il semblerait qu'il y ait incompatibilité entre ta macro et celle-ci.

Merci.

Nouvelle version.

Bye !