اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

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

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

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

شكرا

قام بنشر

السلام عليكم

في المرفق

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

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

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

قام بنشر

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

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

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

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

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

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

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

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

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

قام بنشر

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

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

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

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

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

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

قام بنشر

السلام عليكم

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

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

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

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

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

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

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

ودمتم

قام بنشر

السلام عليكم

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

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

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

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

قام بنشر (معدل)

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

تم تعديل بواسطه الحديثة
قام بنشر

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

  • 2 weeks later...
قام بنشر

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

3.rar

  • 3 years later...
قام بنشر

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information