Format conditionnel spécifique!besoin de macro ou pas?

Sub EtendreTest()
Dim tablo, plage As Range, d As Object, cel As Range, txt
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
[F:F].ClearContents
On Error Resume Next
tablo = Array("test1", "test2", "test3") 'conditions MFC à adapter
Set plage = [E2:E65536].SpecialCells(xlCellTypeConstants, 2)
Set d = CreateObject("Scripting.Dictionary")
For Each cel In plage.Offset(, -4)
  If Not d.Exists(cel.Value) Then
    If IsNumeric(Application.Match(cel.Offset(, 4), tablo, 0)) Then
      txt = cel
      d.Add txt, txt
      [A:A].Replace txt, 1, LookAt:=xlWhole
      Set plage = [A:A].SpecialCells(xlCellTypeConstants, 1)
      plage.Offset(, 5) = cel.Offset(, 4)
      plage = txt
    End If
  End If
Next
Application.EnableEvents = True
Application.Calculation = xlAutomaric
Application.ScreenUpdating = True
End Sub

Sub EtendreTest()
Dim tablo1, tablo2, plage As Range, d As Object
Dim cel As Range, txt As String, coul As Variant
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
On Error Resume Next
Intersect([A2:E65536], ActiveSheet.UsedRange) _
  .Interior.ColorIndex = xlNone 'effacement des couleurs
tablo1 = Array("test1", "test2", "test3", "test4", "test5")
tablo2 = Array(3, 40, 8, 6, 15) 'codes couleurs
Set plage = [E2:E65536].SpecialCells(xlCellTypeConstants, 2)
Set d = CreateObject("Scripting.Dictionary")
For Each cel In plage.Offset(, -4)
  txt = cel
  If Not d.Exists(txt) Then
    coul = Application.Match(cel.Offset(, 4), tablo1, 0)
    If IsNumeric(coul) Then
      d.Add txt, txt
      [A:A].Replace txt, 1, LookAt:=xlWhole
      Set plage = [A:A].SpecialCells(xlCellTypeConstants, 1)
      Intersect(plage.EntireRow, [A:E]) _
        .Interior.ColorIndex = tablo2(coul - 1)
      plage = txt
    End If
  End If
Next
Application.EnableEvents = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub