Sub CollData()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long, j As Long, p As Long
Dim Arr As Variant, Tmp As Variant
Dim WF As WorksheetFunction, x As Long
Dim Tim1, Tim2
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set ws = Sheets("الادخال")
Set Sh = Sheets("استخراج بيانات")
Set WF = WorksheetFunction
LR = ws.Range("a" & ws.Rows.Count).End(3).Row
Tim1 = Sh.Range("A1"): Tim2 = Sh.Range("B1")
Start = Timer
Arr = ws.Range("A4:p" & LR).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 1))
For i = 1 To UBound(Arr, 1)
x = WF.CountIf(ws.Range("p4:p" & i + 3), Arr(i, 16))
If Arr(i, 1) >= Tim1 And Arr(i, 1) <= Tim2 And x = 1 Then
p = p + 1
For j = 1 To 11
Tmp(p, j) = Arr(i, Choose(j, 16, 2, 3, 4, 5, 6, 8, 9, 11, 12, 12))
y = WF.SumIf(ws.Range("k4:k" & LR), Tmp(p, 9), ws.Range("o4:o" & LR))
Tmp(p, 11) = y
Next
End If
Next
If p > 0 Then Sh.Range("a4").Resize(p, UBound(Tmp, 2)).Value = Tmp
MsgBox Round(Timer - Start, 2) & " Seconds"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub