Macro - Suppression de lignes suivant deux critères

Sub concat()

    Sheets("PrR").Select
    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    For i = 2 To RowCount
        Range("b" & i).Select
        dat = ActiveCell.Value
        Range("c" & i).Select
        nom = ActiveCell.Value
        Range("d" & i).Select
        ActiveCell.Value = dat & "," & nom
    Next

    'concatanned feuille PrT
    Sheets("PrT").Select
    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    For i = 2 To RowCount
        Range("b" & i).Select
        dat = ActiveCell.Value
        Range("c" & i).Select
        nom = ActiveCell.Value
        Range("d" & i).Select
        ActiveCell.Value = dat & "," & nom
    Next
End Sub
Sub comppare()
    On Error GoTo err_handler
    Sheets("PrR").Select
    RowCount = Cells(Cells.Rows.Count, "d").End(xlUp).Row
    For i = 2 To RowCount
        Sheets("PrR").Select
        Range("d" & i).Select
        val1 = ActiveCell.Value
        Sheets("PrT").Select
        Cells.Find(What:=val1, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
                   xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True) _
                   .Activate
    Next


err_handler:
    If Err.Number = 91 Then
        Sheets("PrR").Select
        Range("d" & i).Select
        ActiveCell.EntireRow.Delete
        Resume Next
        '    Else
        '        MsgBox "Vous avez une erreur"
    End If
End Sub


Sub netttoya()
    Sheets("PrR").Select
    Columns("D:D").Select
    Selection.ClearContents
    Sheets("PrT").Select
    Columns("D:D").Select
    Selection.ClearContents
End Sub

Sub test()
    Dim PrR, PrT
    Dim i As Long, j As Long
    Dim Nom As String, LaDate As Date
    Dim trouve As Boolean
    Dim nbTrouves As Long
    Dim Cellules
    With Sheets("PrR")
        PrR = .Range("B2:C" & .Cells(.Rows.Count, 3).End(xlUp).Row).Value
    End With
    With Sheets("PrT")
        PrT = .Range("B2:C" & .Cells(.Rows.Count, 3).End(xlUp).Row).Value
        For i = UBound(PrT) To LBound(PrT) Step -1
            trouve = False
            Nom = PrT(i, 2): LaDate = PrT(i, 1)
            For j = UBound(PrR) To LBound(PrR) Step -1
                If PrR(j, 2) = Nom And PrR(j, 1) = LaDate Then
                    trouve = True
                    Exit For
                End If
            Next j
            If Not trouve Then .Cells(i + 1, 1).EntireRow.Delete
        Next i
    End With

End Sub