محمدي عبد السميع

رائع اخي بن عليه جزاك الله كل خير .. هل يمكن ان تكون عدد صفوف الجدول بعدد الاسماء المستدعاه وباقي الصفوف لايرى

السلام عليكم ورحمة الله وبركاته الاستاذ الفاضل ابو محمود الاستاذ الفاضل ابو سما تستحقون الترقيه عن جدارة وفقكم الله سبحانه وتعالى ورضي عنكم وارضاكم

ماشاء الله تبارك الله أفضل الخالقين عمل ولا أروع

جزاكم الله خيرا وبارك فيكم على ردودكم الطيبه

الأستاذ حماده عمر جزاك الله الف خير وجعله في ميزان حسناتك

الأسناذ رجب أثابك الله جنة الفردوس ورزقك خير الدنيا وخير الآخرة

ادراج صورة وحذفها بطريقه سهله .. جزاك الله كل خير وبارك فيك محاسب سعيد بيرم

ماشاء الله بارك الله لك ايها العالم العلامة عبد الله

جزاك الله خيرا وبارك لك استاذ سعيد

تفضل اخي الكريم Sub كشف_دور_ثاني() 'عند الخطأ تخطاه On Error Resume Next 'عشر متغبرات Dim T As Integer, Y As Integer, Z As Integer, V As Integer _ , N As Integer, X As Integer, R As Integer, M As Integer _ , C As Integer, CC As Integer مسح_كشف_دور_ثاني 'اسم شيت المصدر وعمود الترحيل والمعيار .. من شيت المصدر T = Application.CountIf(Sheet1.Range("DI11:DI1000"), "ناجح") / 30 '================================ Application.ScreenUpdating = False With ActiveSheet Y = (T * 38) + 39 'اعمدة منطقة الطباعه .PageSetup.PrintArea = Range("B2:N" & Y).Address End With '================================ Z = 40 Range("نموذج_كشف2").Copy For V = 1 To T Range("B" & Z).PasteSpecial xlPasteAll Set ActiveSheet.HPageBreaks(V).Location = Range("B" & Z) Z = Z + 38 Next V Application.CutCopyMode = False '================================ 'بداية صف الترحيل الى الشيت الهدف N = 6 ' اسم شيت المصدر With Sheet1 X = .Range("A" & .Rows.Count).End(xlUp).Row 'بداية صف الترحيل من الشيت المصدر For R = 11 To X 'عمود المعيار والمعيار من الشيت المصدر If .Range("DI" & R) = "ناجح" Then M = M + 1 Cells(M + N, 2) = M 'عدد اعمدة الترحيل من الشيت المصدر For C = 1 To 12 'اعمدة الترحيل من الشيت المصدر CC = Choose(C, 3, 2, 26, 35, 44, 53, 64, 69, 74, 84, 94) Cells(M + N, C + 2) = .Cells(R, CC) Next C If M Mod 30 = 0 Then N = N + 8 End If Next R End With Range("A2").Activate '================================ Application.ScreenUpdating = True MsgBox "تم ترحيل " & M & " طالب ناجح ", vbMsgBoxRight, "الحمدلله" معاينة On Error GoTo 0 End Sub Sub مسح_كشف_دور_ثاني() Dim Y As Integer Application.ScreenUpdating = False With ActiveSheet Y = .UsedRange.Rows.Count + 40 .Rows("40:" & Y).Delete Range("نموذج_كشف2").Offset(5, 0).Resize(30, 13).ClearContents .PageSetup.PrintArea = Range("نموذج_كشف2").Address End With ActiveWindow.ScrollRow = 2 End Sub Sub معاينة() ActiveWindow.SelectedSheets.PrintPreview End Sub

جزاكم الله خيرا

لماذا تختلف الاحصائيات بتغيير الدالة ؟ ******************** الاجابه للاستاذ القدير عبد الله باقشير السلام عليكم السبب وجود نص في نطاق الارقام وهو الحرف غ دالة SUMPRODUCT ضف فيها شرط للتحقق من وجود رقم لتتم المقارنة =SUMPRODUCT((ISNUMBER($F$3:$F$642))*($F$3:$F$642>=3.2)*($E$3:$E$642="مسلم")) وايضا دالة الصفيف اضف فيها شرط للتحقق من وجود رقم لتتم المقارنة =SUM((ISNUMBER($F$3:$F$642))*($F$3:$F$642>=3.2)*($E$3:$E$642="مسلم")) في امان الله

جزاك الله كل خير اخي mosaline

جزاك الله خيرا

Sub كشف_دور_ثاني() On Error Resume Next Dim T As Integer, Y As Integer, Z As Integer, V As Integer _ , N As Integer, X As Integer, R As Integer, M As Integer _ , C As Integer, CC As Integer مسح_كشف_دور_ثاني T = Application.CountIf(Sheet1.Range("DI11:DI1000"), "دور ثاني") / 30 '================================ Application.ScreenUpdating = False With ActiveSheet Y = (T * 38) + 39 .PageSetup.PrintArea = Range("B2:N" & Y).Address End With '================================ Z = 40 Range("نموذج_كشف2").Copy For V = 1 To T Range("B" & Z).PasteSpecial xlPasteAll Set ActiveSheet.HPageBreaks(V).Location = Range("B" & Z) Z = Z + 38 Next V Application.CutCopyMode = False '================================ N = 6 With Sheet1 X = .Range("A" & .Rows.Count).End(xlUp).Row For R = 11 To X If .Range("CZ" & R) <> "ناجح" Then M = M + 1 Cells(M + N, 2) = M For C = 1 To 12 CC = Choose(C, 3, 2, 26, 35, 44, 53, 64, 69, 74, 84, 94) Cells(M + N, C + 2) = .Cells(R, CC) Next C If M Mod 30 = 0 Then N = N + 8 End If Next R End With Range("A2").Activate '================================ Application.ScreenUpdating = True MsgBox "تم ترحيل " & M & " طالب دور ثاني", vbMsgBoxRight, "الحمدلله" معاينة On Error GoTo 0 End Sub Sub مسح_كشف_دور_ثاني() Dim Y As Integer Application.ScreenUpdating = False With ActiveSheet Y = .UsedRange.Rows.Count + 40 .Rows("40:" & Y).Delete Range("نموذج_كشف2").Offset(5, 0).Resize(30, 13).ClearContents .PageSetup.PrintArea = Range("نموذج_كشف2").Address End With ActiveWindow.ScrollRow = 2 End Sub Sub معاينة() ActiveWindow.SelectedSheets.PrintPreview End Sub كود رائع للترحيل ترحيل مفيد.rar

جزاكم الله خيرا

وبارك الله لك اخي الكريم وشكرا لمدحك

مرورك شرف لنا ايها العالم العلامة شكرا لكم

شكرا لكريم اخلاقك

نقل أو نسخ أوراق العمل إلى مصنف مختلف اضغط بزر الماوس الأيمن فوق علامة تبويب ورقة محددة، ثم انقر فوق نقل أو نسخ في مربع الحوار نقل أو نسخ، في قائمة الكتب ل، نفذ أحد الإجراءات التالية: انقر كتاب جديد لنقل أو نسخ الأوراق المحددة إلى مصنف جديد. في ورقة قبل قائمة، انقر فوق المصنف الذي تريد نقل أو نسخ الأوراق المحددة. نفذ أحد الإجراءات التالية: انقر فوق الورقة التي تريد إدراج الأوراق نقلها أو نسخها مباشرة . انقر فوق تحريك إلى النهاية لإدراج الأوراق

تسمية نطاق - اسم صندوق يمكنك إنشاء نطاق مسمى بسرعة عن طريق الكتابة في المربع الاسم. حدد الخلايا انقر في مربع الاسم، على يسار شريط الصيغة اكتب اسما من كلمة واحدة لFruitList، على سبيل المثال. اضغط على مفتاح أدخل.

تحديد اسم نطاق من الخلايا أو الخلية في ورقة عمل حدد الخلية أو نطاق من الخلايا، أو تحديدات غير متجاورة التي تريد تسميتها. انقر فوق مربع الاسم في الطرف الأيسر من شريط الصيغة . اسم مربع اكتب الاسم الذي تريد استخدامه للإشارة إلى التحديد الخاص بك. اضغط مفتاح الإدخال ENTER

بسم الله الرحمن الرحيم طريقة تفعيل كود استخراج المراكز لأولى للطلبه حمل الملف المرفق فك الضغط عن الملف المرفق ** افتح ملفك ** اضط على Alt وانت ضاغط عليها اضغط F11 ستفتح شاشة الفيجوال في الجزء الايسرالفارغ من الشاشه اضغط بيمين الماوس تظهر شاشه اختر استيراد Import File اختر الملف المحمل بعد فك ضغطه هكذا تم بمشيئة الله نقل الفورمة والموديول الخاص بها اضغط على FormTopTen سيظهرصورة الفورمه اضغط عليها مرتين يظهر الكود.... في أوله نريد تطويع الكود لينلاءم معنا انت محتاج لتعريف RangDate اضغط مرتين على كلمتي RangDate سيتم تحديدها انسخها وهذا التعريف سيتم في صفحة البيانات الاساسيه لك الموجود بها الاسماء وارقام الجلوس والدرجات حدد المدى من المسلسل حتى آخر عمود تستخدمه وانزل بعدد اسماء مدرستك يعني 500 صف بعد هذ التحديد بجوار شريط المعادلات في ناحية الشمال منطقه يظهر بها اسم الخليه اضغط عليها والصق مانسخته واضغط انتر هكذا تم التعريف *** فوق اول خليه تم تحدبدها و في صف يكون فارغ اكتب الرقم 1 والخليه الموجوده بالعمود التالي اكتب الرقم 2 واستمر حتى آخر عمود تم تحديده لماذا ؟ حتى نعرف رقم عمود الاسم ورقم عمود رقم الجلوس ورقم عمود تاريخ الميلاد وارقام الاعمده التي نريدها مثل رقم عمود المجموع الكلي غير الارقام الموجوده بالكود بارقامك انت كما تعرفنا انسخ ورقة الأوائل الموجوده بملفنا الموجود بالمشاركة الأولى الى ملفك اربط الزر الموجود ب Sub kh_Show واحمد الله ثم اخبرنا بالنتيجة ادعو الله ان يكون الشرح واضحا أكواد المراكز الغشره الاوائل للطلبه.rar

جزاكم الله خيرا