اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر (معدل)

السلام عليكم

أستاذ هشام

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

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

أي

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

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

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

تم تعديل بواسطه 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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information