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

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


saffaa

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

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

ولكم الشكر

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

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

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

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

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

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


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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information