Sub Trest()
Dim z As Integer
Dim der As Variant
Dim ListTR As Workbook
WKVAC = ActiveWorkbook.Name
Sheets("TR").Activate
der = Range("A1048576").End(xlUp).Row
Application.ScreenUpdating = False
'Suppression des non droits
For z = der To 2 Step -1
If Not (Cells(z, 7).Value > 1) Then Rows(z).Delete
Next z
'suppression des doublons
Range("A1:G" & Sheets("TR").Range("A1048576").End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 5), Header:=xlYes
' Attribuer 1 sur chaque jour
For z = 2 To Range("A1048576").End(xlUp).Row
Cells(z, 7).Value = 1
Next z
' Additionner les TR par matricules
' supprimer les doublons de matricules
Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Range("J1").Select
ActiveSheet.Paste
ActiveSheet.Range("J1:L" & Sheets("TR").Range("J" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlYes
'compter le nombre de TR par matricule
der = Range("J1048576").End(xlUp).Row
Range("M1").Value = "Nbre TR"
For z = 2 To der
Cells(z, 13).Value = Application.WorksheetFunction.SumIf(Range("A2:A" & Sheets("TR").Range("A" & Rows.Count).End(xlUp).Row), _
Cells(z, 10), Range("G2:G" & Sheets("TR").Range("G" & Rows.Count).End(xlUp).Row))
Next z
Columns("A:I").Delete
Range("A1").Select
Application.ScreenUpdating = True
MsgBox ("Ouverture du fichier pour TR...")
'Ouverture de la source TR
Set ListTR = Application.Workbooks.Open(Application.GetOpenFilename(), local:=True)
Application.ScreenUpdating = False
'Copie des données
Cells.Select
Selection.Copy
Workbooks(WKVAC).Activate
Workbooks(WKVAC).Sheets.Add after:=Sheets("TR")
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Name = "Liste TR"
[B]' c'est ici que ça coince... [/B]
Sheets("TR").Select
der = Range("A1048576").End(xlUp).Row
For z = 2 To der
If Application.WorksheetFunction.CountIf(Sheets("Liste TR").Range("A3:A") _
& Sheets("Liste TR").Range("A" & Rows.Count).End(xlUp).Row, Cells(z, 1)) > 0 Then
Cells(z, 5).Value = "X"
End If
Next z
Application.ScreenUpdating = True
End Sub