كود ترحيل بشرط

[saffaa]

من فضلكم اريد كود ترحيل

للناجحين والراسبين

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

ولكم الشكر

[saffaa]

واذا كان عدد الطلاب كثير يقسمهم لسهولة الطبع

انا رايت احد اعمال استاذي خبور خير في الشهادات

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

ياريت الكود يكون له الميزة دي والف شكر

[عبدالله المجرب]

الاخت الفاضلة

لما لا تستخدمي كود الاستاذ خبور

[saffaa]

أكثر الله عندك الخير

انا اعرف ان الاستاذ خبور من العمالقه

واين هو اخي الاستاذ عبد الله

[عبدالله المجرب]

اختي الفاضلة

ضعي ملف مرفق

وضعي المطلوب وسيتم المحاولة بتقديم المساعدة ان كان هذا ممكن

[saffaa]

اشكرك كثيرا اخي عبد الله

هذا هو المرفق

ترحيل 1.rar

تم تعديل يناير 28, 2012 بواسطه saffaa

[saffaa]

تم اخذ الصفحات الموجوده من مشاركات الاخوة

ولكن هذه الوضعيه في الترحيل هي التي تناسبني

[mhrrd]

من فضلكم اريد كود ترحيل

للناجحين والراسبين

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

ولكم الشكر

واذا كان عدد الطلاب كثير يقسمهم لسهولة الطبع

انا رايت احد اعمال استاذي خبور خير في الشهادات

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

ياريت الكود يكون له الميزة دي والف شكر

تفضلوا هذا بالنسبه للطلب الأول

اما الطلب التاني مايقدر على القدره الا الخالق

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

[saffaa]

اختي الفاضلة

ضعي ملف مرفق

وضعي المطلوب وسيتم المحاولة بتقديم المساعدة ان كان هذا ممكن

تم وضع الملف اخي عبد الله

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

السلام عليكم

تم إضافة كود لترحيل الناجح والراسب فى اوراق منفصلة وتم إضافة كشف ناجح وكشف راسبين فى الشيت

ترحيل 1.rar