ترحيل بيانات محددة إلى ملفات مختلفة عن طريق الكود وليس الماكرو

[سك بابك]

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

أسعد الله أوقاتكم بكل خير اخواني واخوتي

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

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

كما أقدم اعتذاري له لطرحي هذه المشاركة في موضوع جديد ...

ولكن لحاجتي الماسة للحل ونظرا لإنشغاله واصابته التي لم اعلم عنها إلا اليوم فإني أحببت أن لا ازيد على مشاغله

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

عودة للموضوع .....

لدي مجلد به (4) ملفات

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

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

فالطالب الذي يحصل على تقدير ممتاز يتم ترحيل بعض بياناته ( بيانات محددة ) من الملف الرئيسي الخاص بالدرجات إلى الملف الخاص بالتقدير ممتاز (EX ) والبيانات فقط هي خاصة بالاسم والنسبة والتقدير ومن أي فصل هذا الطالب

أي أنه لا يتم ترحيل كامل المعلومات من الملف الرئيسي الخاص بالاختبارات .

برفقه ملف يوضح إن شاءالله المطلوب ... والملف الرئيسي به كود للأخ عبدالله المجرب لنقل البيانات كاملة إلى اوراق بنفس الملف ولكن المطلوب هو الترحيل الى ملفات خارجية وذلك عن طريق الكود ... وليس عن طريق تنفيذ زر الماكرو

وجزاكم الله خير واعتذر للإطالة

Class.rar

تم تعديل ديسمبر 24, 2011 بواسطه سك بابك

[سك بابك]

السلام عليكم

للتذكير بارك الله فيكم وللحاجة ....

[عبدالله المجرب]

السلام عليكم

الله يسلمك اخي الفاضل

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

لن تحتاج لفتح الملفات

فقط ستفتح الملف الرئيسي

(لا تنسى تفك الضغط عن المرفق قبل الاستخدام)

Class.rar

[abouelhassan]

مشكور استاذنا العبقرى

عبدالله المجرب (ابواحمد)

زادك الله علما وكرماً

اخيك بمنتهى الاحترام

تم تعديل ديسمبر 25, 2011 بواسطه abouelhssan

[سك بابك]

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

الاستاذ العزيز والغالي أبو احمد .....

حمداً لله على سلامتك ...واسال الله يديم عليك الصحة والعافية ..

اخي العزيز ..

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

الذي أردته حفظك الله من كل مكروه :

1- ان يتم نفيذ الترحيل تلقائيا عند ظهور النتائج .. فيتم الترحيل إلى الملفات المحددة بناءا على النتيجة التي حصل عليها

2- في الغالب اسماء الملفات تتغير وقد تكون اكثر أو اقل فلو بارك الله فيك جعلت الكود السابق لك ليعمل بناءا على قيمة الخلية في الملف الاخر

3- عند الترحيل لأكثر من مرة يتم تكرار البيانات في جميع الأوراق.... فلو بارك الله فيك يتم مسح البيانات القديمة قبل الترحيل الجديد ليحل محله البيانات الجديدة

اسال الله ان يوفقك ويجزاك كل خير على هذا العطاء والتواصل..

لك مني فائق الإحترام والتقدير

[عبدالله المجرب]

ان يتم نفيذ الترحيل تلقائيا عند ظهور النتائج .. فيتم الترحيل إلى الملفات المحددة بناءا على النتيجة التي حصل عليها

وضح الله يرضى عليك

===

في الغالب اسماء الملفات تتغير وقد تكون اكثر أو اقل فلو بارك الله فيك جعلت الكود السابق لك ليعمل بناءا على قيمة الخلية في الملف الاخر

بفضل الله تم (في المرفق اصبح اسم الملف غير مهم وعددها غير مهم)

===

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

تم بفضل الله

Class.rar

[abouelhassan]

فضلك الله على العباد استاذنا عبدالله المجرب (ابو احمد)

احترام من كل قلب وخالص الدعاء

[سك بابك]

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

المحترم والاستاذ الفاضل عبدالله المجرب ( ابو احمد )

وفقك الله وحفظك ورعاك

لعلي لم أوصل ما اردت بشكل صحيح .. فاعتذر لك وللجميع على ما بدر مني من قصور

أخي العزيز ..

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

والان في هذا الموضوع ... طلبي هو نفس الطلب السابق ولكن على ملفات متفرقه و ايضا الترحيل لبعض العمدة وليس الكل بارك الله فيك وسأرفق لك الملف السابق الذي قمت انت بعمله

بالاضافة الى مرفق بالمطلوب الجديد الموضوع الجديد

اسال الله أن يثيبك ويغفر لك ولوالديك وولدك وأهلك

وبانتظار ردك

جزاك الله كل خير

test.rar

Class.rar

[سك بابك]

لازالت الحاجة قائمة ... فهل من حل بارك الله في الجميع ..

تم تعديل ديسمبر 28, 2011 بواسطه سك بابك

[سك بابك]

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

اخي العزيز عبدالله المجرب

اسعد الله اوقاتك بكل خير

في انتظار ردك بارك الله فيك .... ان لم يكن هناك ما يمنعك أو استحالة عمل ذلك

وفقك الله لكل خير

[سك بابك]

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

الحاجة لا زالت قائمة بارك الله فيكم .. فمن لديهم معرفة أو علم فليسهله علينا

جزاكم الله كل خير

[سك بابك]

يا اخوان ..بارك الله فيكم ... هل طلبي فيه الصعوبة شيء ...

ام انه مستحيل عمل ما تم طلبه ؟؟

ارجوا منكم إيجاد الحل .. فالاختبارات على الابواب والحاجة ماسة جدا لهذا العمل بارك الله فيكم

[عبدالله المجرب]

اخي سك بابك

المسالة ليست صعوبة او سهولة السؤال

السوال هنا

ماهو الوضع الذي تريده انت (لكي يعمل الكود)

هل تريده قبل اغلاق الملف Main

===

في حالي للسوال الاول تم الاستعانة بحدث تفعيل الورقة ليتم تنفيذ الكود

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

[سك بابك]

اخي سك بابك

المسالة ليست صعوبة او سهولة السؤال

السوال هنا

ماهو الوضع الذي تريده انت (لكي يعمل الكود)

هل تريده قبل اغلاق الملف Main

===

في حالي للسوال الاول تم الاستعانة بحدث تفعيل الورقة ليتم تنفيذ الكود

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

اخي عبدالله المجرب ( ابو احمد )

لله درك على سعة صدرك وحسن خلقك

والله لو لم اكن بحاجة ملحة جدا لهذا الملف لم ازعجك أو أزعج أحدا في المنتدى بتكرار سؤالي

فأسأل الله أن يسبغ عليك نعمه ظاهرة وباطنة

نعم اخي ابو احمد ... المطلوب تنفيذ الكود ( ترحيل البيانات إلى الملفات الاخرى ) قبل اغلاق الملف Main

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

بارك الله فيك وبانتظار ردك

تم تعديل يناير 1, 2012 بواسطه سك بابك

[عبدالله المجرب]

السلام عليكم

اخي الفاضل

جرب هذا الكود

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call Excel4Us

End Sub

ضعه في الحدث ThisWorkbook

للعلم لن ينجح استدعاء الكودين (الخاصين بال Class1 و Class 2 ) مرة واحدة وذلك لان الكود الثاني سيمسح نتائج الكود الاول

لذا وضعت لك كود لل Class1 للتجربة

[سك بابك]

جزاك الله كل خير اخي ابو احمد

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

ولكن كما ذكرت اخي أنه ( لن ينجح استدعاء الكودين (الخاصين بال Class1 و Class 2 ) مرة واحدة وذلك لان الكود الثاني سيمسح نتائج الكود الاول )

فهل هناك من طريقة ممكنه تعمل على تجميع الكودين الخاصين بالـ Class 1 و Class 2 مرة واحدة ؟؟

و في حال أنه لا يمكن عمل ذلك

هل من الممكن أن نجعل

1- استدعاء وتنفيذ الكود Class 1 لترحيل البيانات من الورقة Class1 إلى الملفين الخاصين فقط بتقدير EX / VG وهنا لا توجد مشكله من حيث مسح البيانات السابقة لأن الاستدعاء خاص فقط بالورقة Class 1 ولن يكون هناك استدعاء للكود Class 2 على هذين الملفين

2- استدعاء وتنفيذ الكود Class 2 لترحيل البيانات من الورقة Class 2 إلى الملفين الخاصين فقط بتقدير G/ P وهنا لا توجد مشكله من حيث مسح البيانات السابقة لأن الاستدعاء خاص فقط بالورقة Class 2 ولن يكون هناك استدعاء للكود Class 1 على هذين الملفين

بمعنى اخر

الكود الأول خاص للطلاب الذين تقاديرهم ( Excellent / VeryGood ) فقط في الورقة Class 1 وترحل بياناتهم على الملفين EX / VG

والكود الثاني خاص للطلاب الذين تقاديرهم ( Good/ Poor) فقط من الورقة Class 2 وترحل بياناتهم إلى الملفين G / P

اكرر لك شكري وعظيم تقديري ومودتي

دمت بخير

تم تعديل يناير 1, 2012 بواسطه سك بابك

[عبدالله المجرب]

ان شاء الله سأحاول جهدي

الى الغد بإذن الله

[سك بابك]

جزاك الله خيرا اخي العزيز وبارك فيك

[احمدزمان]

السلام عليكم

اخي ابو احمد

ماشاء الله

افكار وحلول اكثر من رائعة

جزاك الله كل خير

[الـعيدروس]

السلام عليكم

الاستاذ الحبيب عبدالله المجرب

ماشاء الله عليك كود جميل

كل يوم نقراء مواهبك استاذ عبدالله

ونستفيد منها

تقبل مروري

[سك بابك]

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

الاخ العزيز ابو احمد

اسال الله ان يوفقك ويجزك عنا خير الجزاء

في انتظار ردك اخي العزيز حيث أن اغلب عملي متوقف على إجابتك حفظك الله من كل مكروه

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

بانتظار ردك وجزاك الله كل خير

[عبدالله المجرب]

السلام عليكم

الاستاذان الفاضلان

احمد زمان

ابونصار

شكراً لكما

[عبدالله المجرب]

اخي سك بابك

====

جرب هذا الكود

Sub Excel4Us_Main()

'Yahya Hussien

Dim FName As String, wbs As Workbook, FileName As String, ArrFile() As Variant, i As Integer, cl As Range

Dim Mainwb As Workbook, NewWb As Workbook

Set Mainwb = ActiveWorkbook

FName = ActiveWorkbook.Path

FileName = Dir(FName & "\*.xls*")

Do Until FileName = ""

    i = i + 1

    ReDim Preserve ArrFile(1 To i)

    ArrFile(i) = FileName

    FileName = Dir

Loop

For i = LBound(ArrFile) To UBound(ArrFile)

    If ArrFile(i) <> Mainwb.Name Then

Workbooks.Open FName & "\" & ArrFile(i)

Set NewWb = ActiveWorkbook

NewWb.Sheets("التقدير").Range("A2:D1000").ClearContents

For Each cl In Mainwb.Sheets("Class 1").Range("G3:G10")

If cl.Value = NewWb.Sheets("التقدير").Range("J1") Then

LR = NewWb.Sheets("التقدير").Range("A" & Rows.Count).End(xlUp).Row + 1

NewWb.Sheets("التقدير").Range("A" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 1).Value

NewWb.Sheets("التقدير").Range("B" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 6).Value

NewWb.Sheets("التقدير").Range("C" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 7).Value

NewWb.Sheets("التقدير").Range("D" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 8).Value

End If

Next

'************************************************************************************************

For Each cl In Mainwb.Sheets("Class 2").Range("G3:G10")

If cl.Value = NewWb.Sheets("التقدير").Range("J1") Then

LR = NewWb.Sheets("التقدير").Range("A" & Rows.Count).End(xlUp).Row + 1

NewWb.Sheets("التقدير").Range("A" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 1).Value

NewWb.Sheets("التقدير").Range("B" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 6).Value

NewWb.Sheets("التقدير").Range("C" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 7).Value

NewWb.Sheets("التقدير").Range("D" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 8).Value

End If

Next

NewWb.Save

NewWb.Close False

  End If

1 Next i

End Sub

ضعه في موديول وضع هذا في حدث ThisWorkeBook

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call Excel4Us_Main

End Sub

[سك بابك]

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

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

كود ولا أروع بروعة حضورك ياغالي

جزاك الله خيرا وبارك فيك

طلب بسيط إن امكن ...

هل من الممكن عند الترحيل أن يتم نسخ التنسيق أيضا ؟؟

تم تعديل يناير 7, 2012 بواسطه سك بابك