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

[SSI83000]

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

 

[gosselien]

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

Bonjour,

si tu relis la charte, il y est dit que c'est plus facile avec le fichier

Je débroussaille pour les autres intervenants

P.

 

[SSI83000]

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

Bonjour Gosselien oui je sait très bien merci lol mais en fait en isolant la ligne de code correspondant à ma recherche je pensais sa aurait été suffisant mais nom je vais faire donc un fichier joint