VBA IF et COUNTIF...

der = Sheets("Liste TR").Range("A1048576").End(xlUp).Row
    For z = 2 To der
        If Application.CountIf(Sheets("Liste TR").Range("A3:A" & der), Cells(z, 1)) > 0 Then
         Cells(z, 5).Value = "X"
        End If
    Next z

With Sheets("Liste TR")
' un point va indiquer à quel onglet on fait référence
der = .Range("A1048576").End(xlUp).Row
    For Z = 2 To der
        If Application.CountIf(.Range("A3:A" & der), .Cells(Z, 1)) > 0 Then
         .Cells(Z, 5).Value = "X"
        End If
    Next Z
End With

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

Sheets("TR").Activate
With Activesheet
der = .Range("a" & Rows.Count).End(xlUp).Row
For z = 2 To der
If WorksheetFunction.CountIf(.Range("A2:A" & derlig), .Cells(z, 1)) > 0 Then .Cells(z, 5).Value = "X"
Next z
End With

Option Explicit

Private Sub CommandButton1_Click()
Dim derlig As Long,  i As Long

  With Sheets("BASE")
  derlig = .Range("e" & Rows.Count).End(xlUp).Row

  For i = 5 To 10
  Range("d" & i) = Application.SumIf(.Range("e3:e" & derlig), Range("c" & i), .Range("g3:g" & derlig))
  Range("f" & i) = Application.CountIfs(.Range("c3:c" & derlig), Range("h" & i), .Range("e3:e" & derlig), Range("c" & i))
  Range("g" & i) = Application.CountIfs(.Range("c3:c" & derlig), Range("i" & i), .Range("e3:e" & derlig), Range("c" & i))
  Next i
  End With
End Sub

Option Explicit
Sub Test()
Dim derlig&, z&, y&

    derlig = Range("a" & Rows.Count).End(xlUp).Row
    For y = 2 To derlig
        If WorksheetFunction.CountIf(Range("a2:a" & derlig), Cells(y, 1).Row) > 0 Then
            z = z + 1
        End If
        Cells(2, 3) = z
    Next y
End Sub

'OU ENCORE COMME CECI
Option Explicit
Sub Test()
Dim derlig&, i&

  derlig = Range("a" & Rows.Count).End(xlUp).Row
  For i = 2 To derlig
  If Cells(i, 1) > 0 Then Cells(i, 3) = "x"
  End If
  Next i
End Sub