ترحيل بيانات الطلبة الراسبين

[خالد الشاعر]

الى الاستاذة الخبراء

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

وليس ترحيل ثم اضافة صف فارغ اريد مع ماكرو الترحيل يترك صف فارغ بين الاسماء

فهل ممكن المساعدة

شكرا

[خالد الشاعر]

السادة الخبراء

ارفق لكم نموذج من شيت الكنترول للتوضيح

وشكراً

____________.rar

[خالد الشاعر]

للرفع

[عبدالله باقشير]

السلام عليكم

في المرفق

كود لترحيل دور ثاني بتجاوز صف

وعملية النسخ تتم للاعمدة المطلوبة فقط

Sub دور_ثاني()
Dim R As Integer, N As Integer
Application.ScreenUpdating = False
Sheets("Sec-exam").Range("A14:BS2000").Clear

N = 13   ' الصفوف الخارجةعن البيانات اعلى الورقة
    
    For R = 14 To 113
        If Cells(R, 62) = "دون المستوى" Then
            N = N + 2
            Range("A" & R).Range("A1:D1,F1:BJ1,BS1").Copy
            With Sheets("Sec-exam")
                .Range("A" & N).PasteSpecial xlPasteValues
                .Range("A" & N).PasteSpecial xlPasteFormats
                .Range("A" & N) = (N - 13) / 2
             End With
            Application.CutCopyMode = False
        End If
    Next
    MsgBox "تم ترحيل " & (N - 13) / 2, vbMsgBoxRight, "الحمد لله"
    Application.ScreenUpdating = True
End Sub

========================================= كود لترحيل الناجحين بدون تجاوز صفوف وعملية النسخ تتم للاعمدة المطلوبة فقط

Sub ناجح()
Dim R As Integer, N As Integer
Application.ScreenUpdating = False
Sheets("Success").Range("A14:BS2000").Clear

N = 13   ' الصفوف الخارجةعن البيانات اعلى الورقة
    
    For R = 14 To 113
        If Cells(R, 62) <> "دون المستوى" Then
            N = N + 1
            Range("A" & R).Range("A1:D1,F1:BJ1,BS1").Copy
            With Sheets("Success")
                .Range("A" & N).PasteSpecial xlPasteValues
                .Range("A" & N).PasteSpecial xlPasteFormats
                .Range("A" & N) = N - 13
             End With
            Application.CutCopyMode = False
        End If
    Next
    MsgBox "تم ترحيل " & N - 13, vbMsgBoxRight, "الحمد لله"
    Application.ScreenUpdating = True
End Sub

ودمتم في حفظ الله

____________.zip

[خالد الشاعر]

استاذى القدير

تسلم ايدك ياباشا

اشكرك جداًً جداًً الف شكر

و اطمع فى المساعدة مرة ثانية فى هذا الموضوع

http://www.officena.net/ib/index.php?showtopic=28950

الف شكرا

[يوسف عطا]

استاذنا الفاضل خبور بك خير

بعد إذن الأستاذ صاحب الدار

أى صاحب الموضوع

فى الدور الثانى لا نحتاج غير مجموع كل مادة والمجموع الكلى

فلاتوجد أعمال سنة ولا ملفات إنجاز

أيضاً يختلف الوضع فى حالة حالة القيد

فالطالب المنقول أو المستجد الذى له دور ثانى لو رسب فيه يبقى للإعادة

أما الطالب الباقى لو رسب فى الدور الثانى ايضاً فليس من حقه الإعادة بالمدرسة

هل يمكن أن نتدبر هذه النقاط ؟؟

[خالد الشاعر]

اشكر الاستاذ يوسف عطا للتوضيح

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

و شكرا

[عبد الفتاح كيرة]

لقد استفدت من هذا الكود المحكم للأستاذ خبور جدا

أرجو منه أن يتفضل بشرح الأجزاء المهمة فى الكود

ولو بتعليق بسيط على الأسطر

وأن يتصدق علينا بذلك

إن الله يجزى المتصدقين

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

[عبدالله باقشير]

السلام عليكم

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

استخدم في الكود بدلا من المسح الكلي

في هذه الجزئية:

Sheets("Sec-exam").Range("A14:BS2000").Clear

مسح جزئي

Sheets("Sec-exam").Range("A14:BS2000").ClearContents

الاخ KEMAS الكود اخي عبارة عن نسخ بيانات في اعمدة معينة

Range("A" & R).Range("A1:D1,F1:BJ1,BS1").Copy

بشرط في عمود معين

If Cells(R, 62) <> "دون المستوى" Then

ولصق خاص PasteSpecial

القيم xlPasteValues

الفورمات xlPasteFormats

جرب تسجل ماكرو لنسخ خلايا معينة

ثم اعمل لصق خاص للقيم ثم للفورمات

وانظر الى الكود

ودمتم

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

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

[الحديثة]

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

3.rar

[الحديثة]

الرجاء شرح عمل وتصحيح الكود

[هشام شلبى]

السلام عليكم

ما هو الاساس الذى سيتم عليه الترحيل

يجب ان يكون هناك عمود به نتائج الطلاب الذين هم دون المستوى وباقى الشروط

ايضا ( R , 62 ) ايضا 62 هو رقم العمود الموجود به نتائج الطلاب وعندك العمود 62 فارغ

اضبط الشين اولا والترحيل سيكون سهل ان شاء الله

[الحديثة]

الفاضل المحترم بوش اريد الترحيل على نتيجة الطالب اذا كان الطالب ناجح ينقل الى شيت الناجح واذا كان لة دور ثانى ينقل الى شيت الراسب والعمود الذى بة النتيجة هو العمود 38 او عمود الدوائر وهو العمود 37

تم تعديل يوليو 5, 2009 بواسطه الحديثة

[هشام شلبى]

السلام عليكم

الاخت الفاضلة بالاضافة للاخطاء عند نقل الكود حضرتك كاتبة فى شيت الناجح ( تاجح )

تفضلى المرفق 0 تقبل الله منا ومنك صالح الدعاء

هشام

3.rar

3.rar

[الحديثة]

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

[الحديثة]

الاساذ العزيز بوش وخبراء وعمالقة المنتدى لقد قمت بعمل كود لترحيل الراسب والناجح ولكن لم يترك صف فارغ واريد فى الراسب فقط صف فارغ لعمل الدور الثانى علية ولك كل الحترام وتقدير

3.rar

[ابواليزيد]

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

Sub Macro7()

'

' Macro7 Macro

' Macro recorded 30/10/2008 by zedasalem

'

' Keyboard Shortcut: Ctrl+u

'

Sheets("ÇáÔíÊ").Select

ActiveSheet.Unprotect

Columns("A:EE").Select

Selection.EntireColumn.Hidden = False

Range("DA6:DB6").Select

Selection.AutoFilter

Selection.AutoFilter Field:=1, Criteria1:="쾄 肊"

Range("A7:EE1500").Select

Selection.Copy

Sheets("ØÈÇÚÉ_2").Select

Range("A7").Select

ActiveSheet.Paste

Range("A7").Select

Sheets("ÇáÔíÊ").Select

Application.CutCopyMode = False

Selection.AutoFilter

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

, AllowFormattingCells:=True, AllowFormattingColumns:=True, _

AllowFormattingRows:=True, AllowSorting:=True

Range("M6").Select

ActiveSheet.Protect

End Sub