Private Sub Worksheet_Activate()
Dim ncol%, coldeb%, lig&, d As Object, w As Worksheet, c As Range, x$, n&, col%
ncol = 7
coldeb = 2
lig = 1
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
For Each w In Sheets(Array("Feuil1", "Feuil3")) 'nom des feuilles à adapter
For Each c In w.UsedRange.Columns(1).Cells
x = LCase(c)
If x <> "" Then
If Not d.exists(x) Then
lig = lig + 1
d(x) = lig 'mémorise le n° de ligne
c.Copy Cells(lig, 1) 'copie le nom
End If
n = d(x) 'récupère le n° de ligne
c(1, 2).Resize(, ncol).Copy Cells(n, coldeb) 'copier-coller
For col = coldeb To coldeb + ncol - 1
With Cells(n, col)
If .Interior.ColorIndex = 3 Then 'si rouge
.Value = "AT"
.Font.ColorIndex = 2 'police blache
ElseIf .Interior.ColorIndex = 15 Then 'si gris
.Value = "NT"
.Font.ColorIndex = 2 'police blanche
.Interior.ColorIndex = 1 'fond noir
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
End If
End With
Next col
End If
Next c
coldeb = coldeb + ncol 'décalage vers la droite
Next w
End Sub