( تمت الاجابة ) الاخ الحبيب هشام بعد التحية

[حسين شاكر]

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

الاخ الحبيب هشام بعد التحية

كنت منذ فترة قريبة قمت باكمال الكنترول شيت لمدرستى ( كود الترحيل ناجح راسب دور ثانى ) الكود يعمل عندى

بالمنزل بعد التجربة ولكن بعد ادخال البيانات الخاصة بالطالبات بالمدرسة وعند الضغط على كود الترحيل يعطى رسالة الخطأ ولا يقوم

بالترحيل.

ارجو من سيادتكم كتابة الكود حتى اقوم بنسخة مرة اخرى الى المدرسة علما بان الكود الان لايعمل لدى ( بالمنزل ) نفس رسالة

الخطا . ( بعد كتابة الكود ارجو كتابة اى ملاحظات لتطبيق الكود من ارتفاع الصف وخلافة )

نشكر سيادتكم لحسن تعاونكم وكل عام وانتم بخير

[هشام شلبى]

السلام عليكم

===========

الاخ hussien2222

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

غالبا الكود سيكون بصيغة المذكر "احنمال" او ماشابه مثلا

فى انتظار ردك

[حسين شاكر]

الاخ هشام

شكرا لسرعة التلبية سوف ارسل لك الملف ولكن لى طلب الملف بة ميكرو كثير لا اعرف اى واح يعمل

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

احتاج فقط كود الترحيل ناجح راسب دور ثان ( ياريت اظهار الكود بالمشاركة مع اضافة التعديلات اللازمة)

لكم منى جزيل الشكر

My link

[هشام شلبى]

السلام عليكم

===========

الاخ العزيزhussien2222

هذا هو الكود

Sub KHH_START()

Dim R As Integer, M As Integer, N As Integer, O As Integer

    Sheets("ناجح").Range("B10:df1000").ClearContents

    Sheets("دور ثان فى").Range("B10:df1000").ClearContents

    Sheets("راسب").Range("B10:df1000").ClearContents

    M = 10: N = 10: O = 10

    Application.ScreenUpdating = False

    For R = 1 To 1000

        If Cells(R, 82) = "ناجح" Then

            Range("A" & R).Resize(1, 125).Copy

            Sheets("ناجح").Range("A" & M).PasteSpecial xlPasteValues

            Application.CutCopyMode = False

            M = M + 1

        ElseIf Cells(R, 82) = "دور ثان فى" Then

            Range("A" & R).Resize(1, 125).Copy

            Sheets("دور ثان فى").Range("A" & N).PasteSpecial xlPasteValues

            Application.CutCopyMode = False

            N = N + 1

            ElseIf Cells(R, 82) = "راسب" Then

            Range("A" & R).Resize(1, 125).Copy

            Sheets("راسب").Range("A" & O).PasteSpecial xlPasteValues

            Application.CutCopyMode = False

            O = O + 1

        End If

    Next

    MsgBox ("تم الترحيل ")

    Application.ScreenUpdating = True

End Sub

اسم الكود

KHH_START()

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

=IF(AND(CG10=0;CH10=0);"ناجح";IF(CG10>2;"راسب";"دور ثان فى"))

كان بعد عبارة له دور ثان فى يوجد مسطرة تم ازالتها

والان الكود يعمل بشكل جيد

شاهد المرفق

كنترول الصف 2010 الاول1.rar