Couleur automatique graph secteur

Bonjour
J'ai une feuille "TOP5" avec plusieurs graph en secteur.
Je souhaite pour tout ces graph attribuer la même couleur aux secteurs portant le même nom de de projet.

Dans ma macro "This_Worksheet_TOP5", je copie et dédoublonne tous les projets de ma feuille "TOP5" en colonne A de ma feuille "Data"


Call ViderPrj("Data", 1)
ka = 2
For a = 1 To Worksheets("TOP5").Columns("A").Find("Fin", , , , xlByRows, xlNext).Row - 1
If Worksheets("TOP5").Range("A" & a).Value Like "*Support*" ThenWorksheets("Data").Range("A" & ka) = Worksheets("TOP5").Range("A" & a).Value
ka = ka + 1
End If
Next
Call SupprimerDoublons("Data", 1)
Private Sub ViderPrj(FeuilleATraiter As String, ColonneATraiter As Integer)
Dim i As Integer, DLV1 As Integer
DLV1 = Sheets(FeuilleATraiter).Columns(ColonneATraiter).Find("", , , , xlByRows, xlNext).Row - 1
For i = DLV1 To 2 Step -1 Sheets(FeuilleATraiter).Cells(i, ColonneATraiter).Value = ""
Next i
End Sub
Private Sub SupprimerDoublons(FeuilleATraiter As String, ColonneATraiter As Integer)
Dim i As Integer, j As Integer, DLV1 As Integer
DLV1 = Sheets(FeuilleATraiter).Columns(ColonneATraiter).Find("", , , , xlByRows, xlNext).Row - 1
For i = DLV1 To 2 Step -1 For j = i - 1 To 1 Step -1
If Sheets(FeuilleATraiter).Cells(i, ColonneATraiter).Value = Sheets(FeuilleATraiter).Cells(j, ColonneATraiter).Value Then _
Sheets(FeuilleATraiter).Cells(j, ColonneATraiter).Delete Shift:=xlUp
Next j
Next i
End Sub

En colonne B de "Data", il y a une couleur dans chaque cellule et l'idée serait de rebalayer ma feuille "TOP5" et à chaque fois qu'il trouve un prjet, il va chercher la couleur correspondante dans l'onglet "Data" et l'affecte au secteur du graph.Est-ce qq'un pourrais m'aider ???