Microsoft 365 recopie avec mise en forme

Function RechCoul(ByVal Arg, ByVal Rng As Range)
   Dim Cel As Range
   On Error Resume Next
   Set Cel = Rng(WorksheetFunction.Match(Arg, Rng.Columns(1), 0), 2)
   If Err Then
      RechCoul = CVErr(xlErrNA)
      ThisWorkbook.Consigne Application.Caller, &HBABABA
   Else
      RechCoul = Cel.Value
      ThisWorkbook.Consigne Application.Caller, Cel.Interior.Color
      End If
   End Function

Private Cln As New Collection
Public Sub Consigne(ByVal Cel As Range, ByVal Coul As Long)
   Cln.Add Array(Cel, Coul)
   End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
   Dim T()
   Do While Cln.Count > 0
      T = Cln(1): Cln.Remove 1
      T(0).Interior.Color = T(1)
      Loop
   End Sub