كود استدعاء بيانات حسب الشهر والسنة

[محمد عبد الناصر]

في الملف المرفق يوجد عدد 2 شيت 

الشيت الاول بإسم "تقرير السنين" والشيت الثاني بإسم "محمود" ـ

في شيت تقرير السنين في الخلية 
A3 مكتوب اسم الشهر
وفي الخلية 
B3 مكتوب رقم السنة

المطلوب كود يقوم باستدعاء البيانات المكتوبة في الخلايا المذكورة ووضعها في شيت تقرير السنين

الملف المرفق موضح المطلوب

Naser.xlsm

[ابراهيم الحداد]

السلام عليكم ورحمة الله

اليك الملف بعد اضافة بعض البيانات لعام 2022 للتجربة

Sub GteData()
Dim ws As Worksheet, Sh As Worksheet
Dim Arr(), Temp()
Dim y As Integer, m As Integer
Dim yy As Integer, mm As Integer
Dim i As Long, j As Long, p As Long
Set ws = Sheets("تقرير السنين")
Set Sh = Sheets("محمود")
ws.Range("A9:E" & ws.Range("B" & Rows.Count).End(3).Row).ClearContents
m = Month("01/" & ws.Range("A3").Value)
y = ws.Range("B3").Value
Arr = Sh.Range("A9:E" & Sh.Range("B" & Rows.Count).End(3).Row).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
yy = Year(Arr(i, 2))
mm = Month(Arr(i, 2))
If yy = y And mm = m Then
p = p + 1
For j = 1 To UBound(Arr, 2)
Temp(p, j) = Arr(i, j)
Next
End If
Next
If p > 0 Then ws.Range("A9").Resize(p, UBound(Temp, 2)).Value = Temp
End Sub

Naser.xlsm

[محمد عبد الناصر]

شكرا اخي الكريم كود رائع تم تجربة الملف 

[سليم حاصبيا]

بعد اذن الاستاذ إبراهيم 

هذا الكود

Option Explicit
Sub My_Repport()

Dim Mh As Range, Single_Cel As Range
Dim Y%, M%, i%, x%
Dim My_Months(), Arr_Year()
x = 6

Takrir.Range("A5").CurrentRegion.Offset(1).ClearContents

Arr_Year = Array(2020, 2021, 2022, 2023, 2024, 2025)
My_Months = Array("يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _
          "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر")

If IsError(Application.Match( _
Takrir.Range("B3"), Arr_Year, 0)) Then Exit Sub

If IsError(Application.Match( _
 Takrir.Range("A3"), My_Months, 0)) Then Exit Sub
 
 Set Mh = Mahmoud.Range("A5").CurrentRegion.Columns(2)
 
 Y = Takrir.Range("B3")
 M = Application.Match(Takrir.Range("A3"), My_Months, 0)
 
 For Each Single_Cel In Mh.Cells
  If IsDate(Single_Cel) And Month(Single_Cel) = M _
   And Year(Single_Cel) = Y Then
    Takrir.Range("A" & x).Resize(, 5).Value = _
    Single_Cel.Offset(, -1).Resize(, 5).Value
    x = x + 1
   End If
 Next Single_Cel
End Sub

الملف مرفق

Naser_data.xlsm