نجوم المشاركات

@حواديتهذه محاولة يوجد طرق اخرى لكان لضيق وقتي اخترت ابسط الطرق قم بانشاء موديل وضع هذا الكود وانظر الى النتيجة اذا كان هذا ما تريده ملاحظة : لا احبذ استخدام اللغة العربية في الاكسيل لانه تسبب مشاكل في الاكواد لعدة عوامل وفي المرة القادمة اذا اردت اكواد عليك ارفاق ملف يقبل الاكواد مثل XLSM Sub test() Dim last_row As Long Dim rng, rng1 As Range last_row = ThisWorkbook.Worksheets("الاكواد").Cells(Rows.Count, 1).End(xlUp).Row Set rng = Range("C3:C" & last_row) Set rng1 = Range("D3:D" & last_row) rng.Formula = "=SUMIF(اليوميه!$A$1:$A$1048575,A3,اليوميه!$C$1:$C$1048575)" rng1.Formula = "=SUMIF(اليوميه!$A$1:$A$1048575,A3,اليوميه!$D$1:$D$1048575)" rng.Value = rng.Value rng1.Value = rng1.Value End Sub تحياتي .

السلام عليكم ورحمة الله اخى الكريم الكود يقوم بمسح البيانات حتى الصف رقم 49 ..سيتم رفع الملف بعد التعديلات لصعوبة تطبيقها بنفسك قوائم.xlsm

السلام عليكم و رحمة الله تم الغاء شرط العدد 40 سواء بالنسبة للذكور او الاناث و اصبح الشرط هو انتماء التلميذ للفصل و النوع فقط ..هذا و الله ولى التوفيق Sub AdClass() Const K1 = "ذكر": Const K2 = "أنثى" Dim Sh As Worksheet, ws As Worksheet Dim LR As Long, p As Long, q As Long Dim Fsl As String, C As Range Application.ScreenUpdating = False Set Sh = Sheets("بيانات"): Set ws = Sheets("فصول") ws.Range("D10:I49") = "": ws.Range("K10:P49") = "" LR = Sh.Range("E" & Rows.Count).End(3).Row Fsl = ws.Range("O7").Value For Each C In Sh.Range("J10:J" & LR) If C.Value = Fsl And C.Offset(0, -3) = K1 Then p = p + 1 ws.Range("D" & p + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value ElseIf C.Value = Fsl And C.Offset(0, -3) = K2 Then q = q + 1 ws.Range("K" & q + 9).Resize(, 6).Value = Sh.Range("D" & C.Row).Resize(, 6).Value End If Next Application.ScreenUpdating = True End Sub

مشكلته كانت بسيطة لكن مؤثرة ومحيرة بعض الشيء اسم الورقة الموجودة في الكود ليست نفسه كما في داخل الورقة . من الوهلة الاولى عند النظر اليها تعتقد انها نفس الشيء( لتجنب هكذا مشاكل استخدم خاصية copy & paste) الشي الثاني يجب ايضا ان تشير للورقة لهذا السطر ايضا If Sheet1.Cells(i, 4) - Date >= 0 And Sheet1.Cells(i, 4) - Date <= 30 Then اتمنى ان تكون الامور جيدة الان . تذكير بتاريخ انتهاء العقود.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته نعم اخي لازم تقوم بتعديل المعادلة على حسب متطلباتك بتغيير الارقام كما في الصورة المرفقة وعليها مثال لطلبك Book1.xlsx