المطلوب ترحيل الراسبين فى كل مادة على حده فى صفحة منفصلة

[نورانور]

السلام عليكم

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

ولكم جزيل الشكر

ثانية نهاية العام 2015.rar

[ياسر خليل أبو البراء]

الأخ الفاضل نور أنور

يرجى وضع نموذج لشكل المخرجات في ورقة عمل أخرى ..

وهل أوراق العمل الخاصة بكل مادة جاهزة أم أنك تريد إنشائها بالكود ؟

وما هي شروط عملية الترحيل .. يفترض أن توضح كل التفاصيل المطلوبة لعملية الترحيل ..

وهل الراسبين شيء يختلف عن الحاصلين على أقل من الدرجة لصغرى ..فكيف يتم دمجهما في ورقة عمل واحدة أم أن لكل مادة سيكون هناك ورقتي عمل !!!

ابدأ مثلاً باللغة العربية وضع شكل المخرجات في ورقة عمل للعمل عليها ..

تقبل تحياتي

[نورانور]

االسلام عليكم

أخى العزيز الاستاذ ياسر

شكرا لحسن ردكم  واسف لتأخرى فى المتابعة لأنى كنت بوعكة صحية والحمد لله

مرفق ملف بالتوضيحات المطلوبة وجزاكم الله خيرا

2ثانية نهاية العام 2015.rar

[ياسر خليل أبو البراء]

أخي الفاضل نور أنور

تفضل الملف المرفق عله يفي بالغرض

Sub TarhilRaseb()
    Dim I As Long, X As Long
    Dim WS As Worksheet, SH As Worksheet
    Dim RngA As Long, RngB As Long
    Dim RngColA As Long, RngColB As Long
    
    Set WS = Sheets("علمى"): Set SH = Sheets("Raseb")
    RngA = SH.Range("D2").Value: RngB = SH.Range("E2").Value
    RngColA = SH.Range("D3").Value: RngColB = SH.Range("E3").Value
    X = 6
    
    Application.ScreenUpdating = False
        SH.Range("A6:F1000").ClearContents
        With WS
            For I = 12 To .Cells(Rows.Count, 1).End(3).Row
                If .Cells(I, RngColA) < RngA Or .Cells(I, RngColB) < RngB Then
                    SH.Cells(X, 1).Value = SH.Cells(X, 1).Row - 5
                    SH.Cells(X, 2).Value = WS.Cells(I, 2).Value
                    SH.Cells(X, 3).Value = WS.Cells(I, 3).Value
                    SH.Cells(X, 4).Value = WS.Cells(I, 12).Value
                    SH.Cells(X, 5).Value = WS.Cells(I, RngColA).Value
                    SH.Cells(X, 6).Value = WS.Cells(I, RngColB).Value
                    X = X + 1
                End If
            Next I
        End With
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Raseb All Subjects.rar

[نورانور]

شكرا أخى ياسر عمل اكثر من رائع  وفوق اكثر ماتوقعته  وجزاك الله خيرا ومتعك بالصحة والعافية

[ياسر خليل أبو البراء]

الحمد لله أن تم المطلوب أخي الكريم نور

يرجى تحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

تقبل ودي وتحياتي