الرجاء المساعدة فى تعديل الكود

[alaa111]

المصنف03.xlsx

Sub ÇÓÊÏÚÇÁ()
On Error Resume Next
If [B4] = "" And [C4] = "" And [E4] = "" Then
MsgBox "íÌÈ ÇÎÊíÇÑ ÍÓÇÈ ÈÏáÇáÉ ÇáÍÇáÉ Çæ ÇÓã ÇáäÒíá Çæ ÇÎÊÇÑ ÑÞã ÇáÛÑÝÉ", vbInformation + vbMsgBoxRight, "ÊäÈíå"
Else
[B9:H200].ClearContents
[B6] = "" & [K1]
Application.ScreenUpdating = False
For x = 9 To Sheets.Count
MySheets = Sheets(x).Name
If Sheets(MySheets).Name = "Search" Then Exit For
For R = 3 To Sheets(MySheets).[c1500].End(xlUp).Row
If (Sheets(MySheets).Cells(R, 5) = [B4] Or Sheets(MySheets).Cells(R, 10) = [C4] Or Sheets(MySheets).Cells(R, 1) = [E4]) And (Sheets(MySheets).Cells(R, 2) >= [G4] And Sheets(MySheets).Cells(R, 4) <= [H4]) Then
With Sheets("ÇáÞíæÏ").[B200].End(xlUp)
          .Offset(1, 0) = Sheets(MySheets).Cells(R, 1)
          .Offset(1, 1) = Sheets(MySheets).Cells(R, 10)
          .Offset(1, 2) = Sheets(MySheets).Cells(R, 2)
          .Offset(1, 3) = Sheets(MySheets).Cells(R, 3)
          .Offset(1, 4) = Sheets(MySheets).Cells(R, 4)
          .Offset(1, 5) = Sheets(MySheets).Cells(R, 5)
          .Offset(1, 6) = Sheets(MySheets).Cells(R, 6)
        End With
     End If
   Next R
Next x
Application.ScreenUpdating = True
MsgBox "!Êã ÇÓÊÎÑÇÌ ÇáßÔÝ ÇáãØáæÈ ÈäÌÇÍ", vbInformation + vbMsgBoxRight, "Êã ÇáÇÓÊÎÑÇÌ"
[B4:E4].ClearContents
End If
End Sub

اريد ضبط الكود حتى يعمل بشكل صحيح

اريد الاستعلام حالة الوصول او الاسم  او برقم الغرفة