ترحيل البيانات ونسخ التنسيق الخاص بالصف(B7:N7) لغاية عدد البيانات المرحلة

[أبو محمد عباس]

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

الاخوة الاعزاء والاساتذة الافاضل

جزاكم الله خيرا وجعل جميع اعمالكم في ميزان حسناتكم

الملف المرفق فيه كود عملته من خلال تسجيل ماكرو وهو كبير نوعا ما لكنه يفي بالغرض واعمل به منذ وقت

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

بعد ذلك اقوم بتنسيق البيانات للورقة الجديدة المنسوخة من  استمارة ثم  اقوم بتسمية الورقة الجديدة باسم المدرسة المرحلة بيانتها بدل اسم ( استمارة )

وهذا ياخذ وقتا كما تعلمون ارجو  ابداء المساعدة الممكنة اذا كان هناك اختصار للكود او كود جديد يقوم بنفس الفكرة لكنه يقوم بنسخ تنسيق الصف (B7:N7 ) من ورقة استمارة على جميع البيانات المرحلة من حيث التخطيط وحجم الخط اقصد ان تكون البيانات داخل جدول مخطط بالاضافة ان تكون الورقة الجديدة بعد الترحيل والتي تحمل اسم ( استمارة) ان تاخذ اسم المدرسة  من الخلية (E4) من ورقة الرقم الامتحاني كي احفظها باسم المدرسة لاحقا

تقبل الله منكم صالح الاعمال واثابكم واعطاكم الصحة والعافية

 

قوائم المرحلة المنتهية للكنترول.rar

 

تم تعديل فبراير 10, 2014 بواسطه أبو محمد عباس

[احمد عبد الناصر]

السلام عليكم

 

جرب هذه 

Sub ABBAS()

    Sheets(2).[F4].Value = Sheets(1).[e6].Value
    Sheets(2).[e5].Value = Sheets(1).[E7].Value
    Sheets(2).[M3].Value = Sheets(1).[E3].Value
    Sheets(2).[L5].Value = Sheets(1).[K5].Value
    Sheets(2).[M5].Value = Sheets(1).[K6].Value
    Sheets(2).[N5].Value = Sheets(1).[K7].Value
    Sheets(2).[L5].Value = Sheets(1).[K5].Value
    Sheets(2).[C5].Value = Sheets(1).[F4].Value
    Sheets(2).[C6].Value = Sheets(1).[E4].Value
    Sheets(2).[L5].Value = Sheets(1).[K5].Value
    Sheets(1).Range("a2:c" & Range("a" & Rows.Count).End(xlUp).Row).Copy
    Sheets(2).Range("B8").PasteSpecial (xlPasteValues)
    Sheets(2).Range("b7").Copy
    Sheets(2).Range("b8:d" & Range("b" & Rows.Count).End(xlUp).Row).PasteSpecial (xlPasteFormats)
    
    Application.CutCopyMode = False
End Sub

تحياتي

[أبو محمد عباس]

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

الاستاذ والاخ الحبيب احمد عبد الناصر  جزاك الله خيرا

كود رائع بارك الله فيك وزادك من فضله خيرا كثيرا

اخي الحبيب هناك التنسيق دائما اخر ستة صفوف من البيانات المرحلة

لايقوم الكود بتنسيقها سوى كانت البيات 50 او 80 او مائة فالستة الاخيرة تبقى دون التنسيق كالصفوف السابقة

بالاضافة ان الكود لايقوم بمسح التنسيقات السابقة  اذا كانت البيانات السابقة مثلا 100 صف والبيانات اللاحقة 50 صف لايقوم بمسح التنسيقات السابقة

وهناك طلب حول انشاء نسخة من الاستمارة باسم المدرسة هل يمكن عملها حيث بالكود الذي ارفقته بمشاركتي الاولى كان موجودا لكن الاسم يكون( استمارة) وانا طلبت ان يكون باسم المدرسة وقمت بتعديل طفيف بالسطر الاخير ليكون التنسيق الى العمود (N) حسب ما ذكرته   {Sheets(2).Range("b8:N" & Range("b"   }

كذلك اضفت Application.ScreenUpdating = False في بداية الكود واضفت Application.CutCopyMode = True في نهاية الكود لمنع الاهتزاز والحمد لله وفقك الله واعانك لعمل الخير والخيرات واعطاك الصحة والعافية

دمتم في رعاية الله وحفظه

صورة ستة صفوف غير منسقة.rar

تم تعديل فبراير 10, 2014 بواسطه أبو محمد عباس

[احمد عبد الناصر]

السلام عليكم

 

جرب هذه 

Sub ABBAS()

    Sheets(2).[F4].Value = Sheets(1).[e6].Value
    Sheets(2).[e5].Value = Sheets(1).[E7].Value
    Sheets(2).[M3].Value = Sheets(1).[E3].Value
    Sheets(2).[L5].Value = Sheets(1).[K5].Value
    Sheets(2).[M5].Value = Sheets(1).[K6].Value
    Sheets(2).[N5].Value = Sheets(1).[K7].Value
    Sheets(2).[L5].Value = Sheets(1).[K5].Value
    Sheets(2).[C5].Value = Sheets(1).[F4].Value
    Sheets(2).[C6].Value = Sheets(1).[E4].Value
    Sheets(2).[L5].Value = Sheets(1).[K5].Value
    Sheets(2).Name = Sheets(1).[E4].Value
    Sheets(2).Range("b8:n" & Sheets(2).UsedRange.Rows.Count).Clear
    Sheets(1).Range("a2:c" & Range("a" & Rows.Count).End(xlUp).Row).Copy
    Sheets(2).Range("B8").PasteSpecial (xlPasteValues)
    Sheets(2).Range("b7").Copy
    Sheets(2).Range("b8:n" & Sheets(2).Range("b" & Rows.Count).End(xlUp).Row).PasteSpecial (xlPasteFormats)
    
    Application.CutCopyMode = False

End Sub

عندي استفسار هل يتم تغير اسم الصفحة المسماة استمارة  او   يتم ادراج صفحة جديدة باسم المدرسة منسوخة من صفحة استمارة 

 

تحياتي

[أبو محمد عباس]

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

الاستاذ والاخ الحبيب احمد عبد الناصر

بارك الله فيك ورزقك خير الدنيا وخير الاخرة

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

اما اذا جاء الترحيل بعد ترحيل بيانات كثيرة تبقى  الصفوف السابقة مخططة دون حذفها اقصد تكون صفوف مخططة اكثر من البيانات المرحلة

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

تقبل فائق احترامي وتقديري

 

القوائم بعد الكود الجديد.rar

[احمد عبد الناصر]

السلام عليكم

 

جرب هذه

Sub ABBAS2()


    Dim sh0 As Worksheet
    Dim sh1 As Worksheet
    Set sh0 = ThisWorkbook.Sheets("الرقم الامتحاني")
    ThisWorkbook.Sheets("استمارة").Copy After:=Sheets(Worksheets.Count)
    Set sh1 = ThisWorkbook.Sheets(Worksheets.Count)
    sh1.Name = sh0.[E4].Value

        sh1.[F4].Value = sh0.[e6].Value
        sh1.[e5].Value = sh0.[E7].Value
        sh1.[M3].Value = sh0.[E3].Value
        sh1.[L5].Value = sh0.[K5].Value
        sh1.[M5].Value = sh0.[K6].Value
        sh1.[N5].Value = sh0.[K7].Value
        sh1.[L5].Value = sh0.[K5].Value
        sh1.[C5].Value = sh0.[F4].Value
        sh1.[C6].Value = sh0.[E4].Value
        sh1.[L5].Value = sh0.[K5].Value

            sh1.Range("b8:n" & sh1.UsedRange.Rows.Count + 10).Clear
            sh0.Range("a2:c" & sh0.[K7].Value + 1).Copy
            sh1.Range("B8").PasteSpecial (xlPasteValues)
            sh1.Range("b7").Copy
            sh1.Range("b8:n" & sh1.[N5].Value + 7).PasteSpecial (xlPasteFormats)
            sh1.[b7].Select
            Application.CutCopyMode = False


End Sub

تحياتي

تم تعديل فبراير 11, 2014 بواسطه احمد عبد الناصر

[ابوالفتح]

الاخوة الاعزاء أريد رفع ملف لتعديله  كيف ؟

[أبو محمد عباس]

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

الاستاذ والاخ الحبيب احمد عبد الناصر جزاك الله خيرا

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

حفظكم الله وانا في الحقيقة تعبتك معاية اسال الله سبحانه وتعالى ان يجعل جميع اعمالك في ميزان حسناتك

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

لكن اطمع في كرمكم ربما لم اوصل الفكرة السابقة الكود السابق في المشاركة الرابعة (4) كذلك ممتاز على وضعه الحالي

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

فاذا كان بالامكان ذلك فجزاك الله خيرا اما عملكم الحالي فهو في قمة الابداع والروعة

وفقك الله واعانك لعمل الخير وزادك من الخيرات

تقبل فائق احترامي وتقديري

تم تعديل فبراير 11, 2014 بواسطه أبو محمد عباس

[أبو محمد عباس]

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

الاخ ابو الفتح بارك الله فيك

اخي  عند رفع ملف لابد ان تقوم بضغطه  باحد برامج الضغط مثلا ونرار

ثم الضفط على  المحرر الكامل ستظهر لك ايقونه ( تصفح ) قم بالضغط عليها

بعدها تختار الملف المضغوط من الكمبيوتر الخاص بكم  بعد ان يتم  رفعه

قم بضغط ايقونة رفع الملف ثم اضافة 

وتقبل فائق احترامي وتقديري

تم تعديل فبراير 11, 2014 بواسطه أبو محمد عباس

[احمد عبد الناصر]

السلام عليكم

 

استاذ عباس اسعد الله صباحك

 

بداية معذرة علي التأخر في الرد

 

شاكر لك كلماتك الطيبة و دعائك الجميل 

 

اعطاك الله الصحة والعافية ورزقك من حيث تحتسب ومن حيث لاتحتسب حفظكم الله .

 

 

 

هو بعد ان يفتح ورقة جديدة باسم المدرسة ان يقوم بنسخ هذه الورقة التي تحمل اسم المدرسة  بمصنف جديد يحمل اسم المدرسة

 

هل بالامكان ان ترفق الملف بالصورة النهائية التي تريدها 

 

تحياتي