جزاك الله خيرا استاذنا العزيز لكنى كنت اتمنى ان يتم الاستدعاء في صفحة واحدة لانى سوف اضطر عند الطباعة لدخول صف صف ولكنى شاكرا لمجهودكم وممنون لتعبكم وهناك كود كان يعمل من قبل في حالة استدعاء بيانات الفرقة كاملة واردت التعديل فيه لكنه لم يفلح وساقوم برفعه لعلكم تقومون بالتعديل عليه فيسهل العمل والكود المقصود هو
Sub CallingData()
Dim data As Worksheet, Ws As Worksheet
Dim Arr As Variant, Temp As Variant
Dim I As Long, j As Long, p As Long
Set data = Sheets("السجل")
Set Ws = Sheets("مواظبة")
Ws.Range("C9:R" & Ws.Range("D" & Rows.Count).End(xlUp).Row + 9).ClearContents
Arr = data.Range("D9:t" & data.Range("D" & Rows.Count).End(xlUp).Row).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For I = 1 To UBound(Arr, 1)
If Arr(I, 2) = Ws.Range("r2") Then
p = p + 1
For j = 1 To 15
Temp(p, j) = Arr(I, Choose(j, 1, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17))
Next
End If
Next
If p > 0 Then Ws.Range("D9").Resize(p, UBound(Temp, 2)).Value = Temp
If p > 0 Then Ws.Range("C9") = 1: Ws.Range("C9").Resize(p).DataSeries Step:=1
End Sub