تعديل على كود ترحيل

[هشام شلبى]

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

اريد فى صفحة الناجح واراسب ان يكون الصف رقم 8 فارغ ويبدأ الترحيل من اول الصف رقم 9

1.rar

[قصي]

مجرد سوال

ما الذي يعجبك في اسم لصقته بشخصك ؟؟

[هشام شلبى]

قدرا هو اختصار لثانى وثالت ورابع اسمى ساغيره ان شاء الله

عفوا اخى قصى

[أيسم إبراهيم]

السلام عليكم

أستاذ هشام

كيف الحال؟؟ أتمنى من الله أن تكون بخير

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

أي

لايمكن أن يترك صف فارغ بدون بيانات

أما لو كنت ستكتب فيه شيئ لابد وأن تملأ كل السطور وتعدل هذا السطر من الكود إلى الشكل التالي

 Sheets("ناجح").Range("A9:CA1000").ClearContents
    Sheets("راسب").Range("A9:CA1000").ClearContents

تم تعديل يونيو 30, 2009 بواسطه aysam

[هشام شلبى]

السلام عليكم

اخى ايسم كيف حالك

استطعت بالفعل ترحيل الراسب الى ما كنت ابغى ولكن ظهرت لى مشكلة اخرى ساحدثك عنها فيما بعد والكود فى الراسب سيكون على الشكل الاتى

[codef Cells(i, 43) = ("ÑÇÓÈ") Then

N = Cells(i, R).Column

With Sheets("ÑÇÓÈ").Columns(N).Rows(1000).End(xlUp)

.Offset(2, 0) = Cells(i, R)

End With]

[عبدالله باقشير]

السلام عليكم

استخدم الكود التالي

Sub KH_START()
Dim R As Integer, M As Integer, N As Integer
    Sheets("ناجح").Range("A9:ap1000").ClearContents
    Sheets("راسب").Range("A9:ap1000").ClearContents
    M = 9: N = 9
    Application.ScreenUpdating = False
    For R = 1 To 1000
        If Cells(R, 43) = "ناجح" Then
            Range("A" & R).Resize(1, 43).Copy
            Sheets("ناجح").Range("A" & M).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            M = M + 1
        ElseIf Cells(R, 43) = "راسب" Then
            Range("A" & R).Resize(1, 43).Copy
            Sheets("راسب").Range("A" & N).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            N = N + 1
        End If
    Next
    MsgBox ("الحمد لله تـــم ترحيل الناجحين و الراسبين إلى أوراق عمل جديدة ")
    Application.ScreenUpdating = True
End Sub

تفضل المرفق

1.rar

[هشام شلبى]

السلام عليكم

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

بارك الله فيك

[قصي]

الف شكر للعلامة خبور