مشكلة في زر الترحيل

[rami.gamal]

السلام عليكم و رحمة الله و بركاته 

انا عندي مشكلة بتواجهني باستمرار في اكواد الترحيل هي ان لما اعمل كود ترحيل بيانات و اربطه بزر الل بيتم ان عندما اضغط على الزر بيتم ترحيل بيانات طاب واحد فقط اول طالب و لكن عندما افعل الكود من محرر الاكواد بيتم ترحيل كامل الصفوف حسب الشروط الل انا حاططها في الكود .

فأرجو من السادة افادتي في مشكلتي و لكم جزيل الشكر و التقدير

و ده ملف مرفق المشكلة في ترحيل الطلبة من شيت السجل الى شيت قائمة الفصل ( الشيت الاخير في كتاب العمل )

سجل الحضانة 2015_2016.rar

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

جرب الكود بهذا الشكل

حاول أن تبتعد عن تنشيط أوراق العمل أثناء كتابة الكود ..من الأفضل استخدام اسم ورقة العمل في أسطر الكود

قم بالإطلاع على الكود وعدل الكود الثاني بنفس الطريقة ..أو يمكن استخدام زر واحد وكود واحد (فقط تغير الخلية F1)

Sub قائمة_مستوى_1()
    Dim R As Integer, RA As Integer, RB As Integer, RC As Integer, FS As Integer
    
    Application.ScreenUpdating = False
        Sheets("قائمة الفصل").Range("C9:J58").ClearContents
        Sheets("قائمة الفصل").Range("D3") = "المستوى الأول"
        RA = 9: RB = 9: RC = 9
        FS = Sheets("قائمة الفصل").Range("F1")
        
        With Sheets("سجل القيد")
            For R = 9 To 408
                If .Cells(R, 6) = "1" And FS = "1" Then
                    .Range("E" & R).Copy
                    Sheets("قائمة الفصل").Range("C" & RA).PasteSpecial xlPasteValues
                    .Range("H" & R).Resize(1, 7).Copy
                    Sheets("قائمة الفصل").Range("D" & RA).PasteSpecial xlPasteValues
                    RA = RA + 1
                ElseIf .Cells(R, 6) = "2" And FS = "2" Then
                    .Range("E" & R).Copy
                    Sheets("قائمة الفصل").Range("C" & RA).PasteSpecial xlPasteValues
                    .Range("H" & R).Resize(1, 7).Copy
                    Sheets("قائمة الفصل").Range("D" & RA).PasteSpecial xlPasteValues
                    RA = RA + 1
                End If
            Next R
        End With
    Application.ScreenUpdating = True
End Sub

 

[rami.gamal]

شكرا استاذ ياسر خليل 

و لكن المشكلة لا تزال قائمة 

انا بس عاوز اعرف ايه الل بيمنع الز من انه ينفذ الكود كاملا

على الرغم من ان الكود يعمل بشكل طبيعي من محرر الأكواد

الى جانب ان المشكلة دي بتقابلني في اكواد الترحيل كلها مش في الملف المرفق فقط

تم تعديل أكتوبر 28, 2015 بواسطه rami.gamal

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

المشكلة في استخدام Select و Activate على ما أعتقد لذلك حاول الابتعاد عن التحديد وستجد الأمور تسير بشكل طبيعي

فيدلاً من استخدام Activate لتحديد أو تنشيط الورقة ، يكفي أن تشير إليها هكذا ...

Sheets("Sheet1").Range("A1:C15").Copy

بدلاً من أن تستخدم الطريقة التالية

Sheets("Sheet1").Activate
Range("A1:C15").Copy

 

[rami.gamal]

لسيادتكم جزيل الشكر أ . ياسر خليل على الاهتمام

و لكن للاسف المشكلة لا تزال قائمة 

اسف اني ازعجت حضرتك

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

هل بدأت في الاستغناء عن تنشيط أوراق العمل وما زالت المشكلة قائمة ؟

وضح المشكلة مرة أخرى بعد التغيير الذي تم على الأكواد التي قمت بتعديلها ..

[rami.gamal]

و الله يا استاذ ياسر انا مش عارف اقول لحضرتك ايه على الاهتمام غير جزاك الله خيرا .

انا عملت زي ما حضرتك قولت بالضبط و استخدمت

With Sheets("سجل القيد")

 و لكن المشكلة لا تزال قائمة و الكود يعمل من محرر الاكواد بصورة طبيعية و لكن عند استخدام الزر المخصص لهذا الكود يتم نقل اول بيان فقط لا غير

انا بحفظ الملف بصيغة .xlsb جربت اغير الصيغة و لكن مافيش فايدة

تم تعديل نوفمبر 1, 2015 بواسطه rami.gamal

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

ارفق الملف مرة أخرى بعد التعديل للإطلاع عليه ...

[rami.gamal]

سجل الحضانة 2015_2016.rar

[rami.gamal]

شكرا جدا يا استاذ ياسر و اسف على الازعاج

الحمد لله الطريقة دي

Sheets("Sheet1").Range("A1:C15").Copy

اشتغلت معايا في الزر كويس جدا 

بس انا ما كنتش واخد بالي كويس 

بس السؤال هنا ليه في تنشيط الشيت الزر ما اشتغلش كما يجب و الاجابة على السؤال ده هتفرق كتير 

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

لا أدري صراحة السبب

ولكن في معظم المواقع التي زرتها أعرف أنه لا ينصح باستخدام  التحديد أو التنشيط لأن هذا من شأنه أن يبطيء عمل الكود

تقبل تحياتي

[rami.gamal]

التحيات لحضرتك و شكرا جزيلا جدا