Modifier une macro en ajoutant de la couleur à une cellule sous condition

Bonjour à tous

j'aurais besoin de votre aide pour amélioré une petite macro que j'utilise je souhaiterais si la valeur de ma BDD = BIP

non seulement il copie le nom de l'agent sa c'est deja le cas mais en plus il me colorie la cellule ou le nom seras copier
comment puis je ajouter cela svp merci

Sub Dispo()
Dim TE(), LE As Long, CE As Long, TS(), LS As Long, CS As Long, TLC() As Long, FSource As Worksheet, FeuilTemp As String
FeuilSelect = Sheets("Dispo").Range("A6").Text
'MsgBox FeuilSelect
On Error Resume Next
FeuilTemp = Sheets(FeuilSelect).Range("P2")
' MsgBox FeuilTemp
Set FSource = ThisWorkbook.Sheets(FeuilTemp)

TE = Intersect(Application.Range(FSource.Rows(2), FSource.Rows(FSource.Rows.Count)), FSource.UsedRange).Value
ReDim TS(1 To UBound(TE, 1) \ 3 + 1, 1 To UBound(TE, 2) * 3 - 2)
ReDim TLC(1 To UBound(TS, 2))
For LE = 2 To UBound(TE, 1)
For CE = 2 To UBound(TE, 2)
On Error Resume Next
Select Case TE(LE, CE)


Case "M": CS = CE * 3 - 5
Case "A": CS = CE * 3 - 4
Case "N": CS = CE * 3 - 3
Case "Pro": CS = CE * 3 + (LE - 2) Mod 3 - 5





Case "BIP": CS = CE * 3 + (LE - 2) Mod 3 - 5








Case Else: CS = 0: End Select


If CS > 0 Then
LS = TLC(CS) + 1: TLC(CS) = LS
TS(LS, CS) = TE(LE - (LE - 2) Mod 3, 34)
End If: Next CE, LE
Sheets("Dispo").[B3].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS


End Sub