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

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


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

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

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