Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If Sh.Name <> ActiveSheet.Name Or Sh.Name = "Couleurs" Then Exit Sub
Dim P As Range, t, ncol%, i&, j%
Set P = Sh.UsedRange
If P.Count = 1 Then
t = P.DisplayFormat.Interior.ColorIndex
Else
t = P 'matrice, plus rapide
ncol = UBound(t, 2)
For i = 1 To UBound(t)
For j = 1 To ncol
t(i, j) = P(i, j).DisplayFormat.Interior.ColorIndex
Next j, i
End If
Application.EnableEvents = False 'désactive les évènements
With Sheets("Couleurs") 'feuille auxiliaire
.Cells.ClearContents 'RAZ
.Range(P.Address) = t
End With
Application.EnableEvents = True 'réactive les évènements
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Workbook_SheetCalculate Sh
End Sub