Private Sub Workbook_Open()
Application.OnTime 1, ThisWorkbook.CodeName & ".MAJ" 'lance la macro
End Sub
Sub MAJ()
Dim chemin$, fichier$, F As Worksheet, ncol%, coldeb%, lig&, d As Object, wb As Workbook, w As Worksheet, c As Range, x$, n&, col%
chemin = ThisWorkbook.Path & "\"
fichier = "Source.xlsx"
If Dir(chemin & fichier) = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: Exit Sub
Set F = Feuil1 'CodeName de la feuille de destination
ncol = 7
coldeb = 2
lig = 2
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
F.Rows(lig + 1 & ":" & F.Rows.Count).Delete 'RAZ
On Error Resume Next
Workbooks(fichier).Close False 'ferme le fichier s'il est ouvert
On Error GoTo 0
Set wb = Workbooks.Open(chemin & fichier) 'ouverture du fichier source
For Each w In wb.Sheets(Array("Feuil1", "Feuil2", "Feuil3", "Feuil4", "Feuil5", "Feuil6")) '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 F.Cells(lig, 1) 'copie le nom
End If
n = d(x) 'récupère le n° de ligne
c(1, 2).Resize(, ncol).Copy F.Cells(n, coldeb) 'copier-coller
For col = coldeb To coldeb + ncol - 1
With F.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
wb.Close False 'ferme le fichier source
End Sub