السلام عليكم
استبدل الكود بهذا (تم استعمال عمود مساعد (AZ))
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range, cel As Range
r = 6: T = 2
If Not Intersect(Target, [AK5]) Is Nothing Then
[Ak6:Ak150,AZ2:AZ150].ClearContents
For Each cl In [D5:D60]
If cl = Target Then MyArr = MyArr & cl.Offset(0, 1) & ","
Next
For Each c In Split(MyArr, ",")
Cells(T, "AZ") = c
T = T + 1
Next
For Each cel In Sheets("ورقة2").[B5:B100]
w = Application.CountIf([AZ2:AZ150], cel)
If w = 0 Then MyAr = MyAr & cel & ","
Next
For Each c In Split(MyAr, ",")
Cells(r, "AK") = c
r = r + 1
Next
End If
End Sub