Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim liste
liste = Array("Résumé", "AA", "BB", "CC")
If IsNumeric(Application.Match(Sh.Name, liste, 0)) Or Intersect(Target, Sh.[A2,A4]) Is Nothing Then Exit Sub
Dim w As Worksheet, v1 As Variant, v2 As Variant, n%, a()
For Each w In Worksheets
If IsError(Application.Match(w.Name, liste, 0)) Then
w.Tab.Color = vbGreen
v1 = Evaluate(Replace(w.Range("A2").Text, ",", ".")) 'virgule remplacée par le point
v2 = Evaluate(Replace(w.Range("A4").Text, ",", ".")) 'virgule remplacée par le point
If IsNumeric(v1) Then If CDbl(v1) > 0.03 Then w.Tab.Color = vbRed: GoTo 1
If IsNumeric(v2) Then If CDbl(v2) > 0.05 Then w.Tab.Color = 49407 'orange
1 If w.Tab.Color <> vbGreen Then
n = n + 1
ReDim Preserve a(1 To 3, 1 To n)
a(1, n) = w.Name
If w.Tab.Color = vbRed Then a(2, n) = "X"
If IsNumeric(v2) Then If CDbl(v2) > 0.05 Then a(3, n) = "X"
End If
End If
Next
'---restitution du tableau---
With Sheets("Résumé")
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
With .[A2] '1ère cellule de destination
If n Then .Resize(n, 3) = Application.Transpose(a) 'Transpose est limitée à 65536 lignes
.Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End With
End Sub