Bonjour Lermite,
Si tu es la !
sur le fichier que tu as eu la gentillesse de me faire
je voudrais a jouter 10 lignes de plus en conservant ton code
Option Explicit
Const Rouge = 3
Const Bleu = 33
Const Noir = 1 '-4142
Sub CoulTablo()
Dim Col As Integer, Lig As Integer, i As Integer, e As Integer
Dim TB(1 To 20) As Integer, R As String
Dim TB2(1 To 20) As Integer, R2 As String
Dim TLig
TLig = Array(7, 11, 15, 16, 17, 18, 19, 20)
Application.ScreenUpdating = False
With ActiveSheet
For i = 1 To 20: TB(i) = Cells(1, i): TB2(i) = Cells(3, i): Next
.[A7:T20].Font.ColorIndex = Noir
.[A3:T3].Font.ColorIndex = Bleu
For Col = 1 To 20
For i = 1 To 20
If .Cells(3, Col) = TB(i) Then
R = R & ", " & .Cells(3, Col).Address
End If
Next i
If R <> "" Then .Range(Mid(R, 2)).Font.ColorIndex = Rouge
Next Col
R = ""
For e = 0 To 7
Lig = TLig(e)
For Col = 1 To 20
For i = 1 To 20
If Cells(Lig, Col) = TB(i) Then
R = R & "," & Cells(Lig, Col).Address
ElseIf Cells(Lig, Col) = TB2(i) Then
R2 = R2 & "," & Cells(Lig, Col).Address
End If
Next i
Next Col
If R <> "" Then .Range(Mid(R, 2)).Font.ColorIndex = Rouge
If R2 <> "" Then Range(Mid(R2, 2)).Font.ColorIndex = Bleu
R = "": R2 = ""
Next e
End With
End Sub