شرح كود الترحيل الراسب والناجح

[يثرب]

الاخوه الافاضل كل سنه و انتم طيبين حاولت مرارا و تكرارا تطبيق الشرح على شيت خاص بى لترحيل الناجحين و الراسبين و لم استطع علما بان الشيت عندى يبدأ  من الخليه a10 مسلسل و الدرجات من الخليه i10 الى bh10  و كلمة راسب او ناجح تظهر فى الخليه bh10 فأرجوا التوضيح فى هذا الكود ما يلزم تغييره و شاكر جدا لردكم مسبقا و هذا كود الاخ رجب جاويش

sub ragab()

Dim lr As Integer, y As Integer

lr = [b10000].End(xlUp).Row

Sheets("ناجحون").Range("a9:ho1000").ClearContents

Sheets("راسبون").Range("a9:ho1000").ClearContents

Application.ScreenUpdating = False

x = 9: y = 9

For i = 9 To lr

If Cells(i, 3).Value = "ناجح" And Cells(i, 4) <> " " Then

Range("a" & i).Resize(1, 223).Copy

Sheets("ناجحون").Range("a" & x).PasteSpecial xlPasteValues

Application.CutCopyMode = False

x = x + 1

ElseIf Cells(i, 3).Value = "له دور ثان" And Cells(i, 4) <> " " Then

Range("a" & i).Resize(1, 223).Copy

Sheets("راسبون").Range("a" & y).PasteSpecial xlPasteValues

Application.CutCopyMode = False

y = y + 1

End If

Next i

MsgBox "تم بحمد الله فصل الناجحين والراسبين فى كشوف منفصلة", vbOKOnly, "ترحيل الناجحون والراسبون"

Application.ScreenUpdating = True

 

[ياسر خليل أبو البراء]

الأخت الفاضلة يثرب

الأفضل إرفاق ملف ووضع الكود بين أقواس الكود ليظهر بشكل منضبط