Lier la Couleur de 2 cellules ??

Sub CentralCouleur()
 For i = 2 To Worksheets.Count
    For j = 10 To 24
        Worksheets("Tableau Central").Cells(j, i + 6).Interior.ColorIndex = Worksheets(i).Cells(j - 2, 4).Interior.ColorIndex
    Next j
 Next i
End Sub

Private Sub Worksheet_Activate()
 For i = 2 To Worksheets.Count
    For j = 10 To 24
        Worksheets("Tableau Central").Cells(j, i + 6).Interior.ColorIndex = Worksheets(i).Cells(j - 2, 4).Interior.ColorIndex
    Next j
 Next i
End Sub

Private Sub Worksheet_Activate()
 Dim NomFeuille, Nom, i As Integer, DerCol As Byte, DebCol As Byte
 DebCol = 2
 For Each Nom In Range(Cells(2, 2), Cells(2, Cells(2, Columns.Count).End(xlToLeft).Column))
    If Nom.Value <> "" Then
        NomFeuille = Nom & "."
        With Worksheets(NomFeuille)
            DerCol = .Cells(6, Columns.Count).End(xlToLeft).Column
            .Range(.Cells(8, 3), .Cells(17, DerCol)).Copy Worksheets("GENERAL").Cells(9, DebCol)
            DebCol = DebCol + DerCol - 2
        End With
    End If
 Next
End Sub

Private Sub Worksheet_Activate()
 Dim Nom1,Nom2,x
 x = 2
 For Each Nom1 In Range(Cells(5, 3), Cells(5, Cells(5, Columns.Count).End(xlToLeft).Column))
        If Nom1.Value <> "" Then
            With Worksheets(CStr(Nom1))
            For Each Nom2 In .Range(.Cells(2, 4), .Cells(2, .Cells(2, .Columns.Count).End(xlToLeft).Column))
                If Nom2.Value <> "" Then
                    x = x + 1
                    .Range(.Cells(4, Nom2.Column), .Cells(4, Nom2.Column + 7)).Copy
                    Cells(8, x).PasteSpecial Paste:=xlPasteAll, Transpose:=True
                End If
            Next
            End With
        End If
 Next
End Sub