وعليكم السلام ورحمه الله وبركاته
تفضل اخى
Option Explicit
Sub Search_Delete()
Dim Arr As Variant, SH As Worksheet, dic As Object
Dim I As Long, Unique_No As String, R As Range, P As Long
Application.ScreenUpdating = False: Application.EnableEvents = False
Set SH = ThisWorkbook.Worksheets("ورقة1")
Arr = SH.Range("B2:F" & SH.Cells(Rows.Count, 2).End(xlUp).Row).Value
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
For I = LBound(Arr) To UBound(Arr)
Unique_No = Arr(I, 1) & Arr(I, 4) & Arr(I, 5)
If Not dic.Exists(Unique_No) Then
dic.Add Unique_No, P
P = P + 1
Else
If R Is Nothing Then
Set R = SH.Cells(I + 1, 1)
Else
Set R = Union(R, SH.Cells(I + 1, 1))
End If
End If
Next I
If Not R Is Nothing Then R.EntireRow.Delete
Application.EnableEvents = True: Application.ScreenUpdating = True
End Sub