اذهب الي المحتوي
أوفيسنا

صناعة ملفات اكسل من ملف اكسل ماستر


إذهب إلى أفضل إجابة Solved by ياسر خليل أبو البراء,

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

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

 

الأخوة الاعزاء

 

لدي ملف اكسل اسمه (Master_file) فيه معلومات الموظفين كيف أصنع ملف أكسل لكل موظف و هذا الملف يأخذ معلوماته من الملف  (Master_file)  اتومايتكيا يعني هو يسوي صناعة للملفات.

مثال مرفق

 

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

 

Master_file.zip

  • Like 1
رابط هذا التعليق
شارك

  • أفضل إجابة

الأخ الحبيب والمعلم الكبير طارق :welcomeani:

اسمح لي أن أتقدم رغم أنه لا يحق لي التدخل بعد ردك :imsorry: ..إلا أنني كنت قد جهزت الكود ولكن عطلني أنني أردت شرحه للاستفادة منه :yes:

الأخ الكريم المنار (ربنا يكفيك شر النار وشر الأشرار ويجعلك من المتقين الأبرار) :fff: :fff:

إليك الملف التالي وإن شاء الله يفي بالغرض

Sub SplitWB()
'يقوم الكود بفصل بيانات كل موظف في مصنف جديد مقسم إلى أوراق عمل جديدة
'--------------------------------------------------------------------
'تعريف المتغيرات
    Dim WB As Workbook
    Dim Arr
    Dim I As Long
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'تعيين قيمة للمتغير ليساوي كل القيم في النطاق الحالي في ورقة العمل
'المتغير يخزن البيانات على شكل مصفوفة
        Arr = ThisWorkbook.Sheets("Sheet1").Cells(1).CurrentRegion.Value
'حلقة تكرارية من الصف الثاني وحتى آخر صف به بيانات
'الحد الأعلى للبعد الأول للمصفوفة ألا وهو بعد الصفوف [UBound(Arr, 1)] حيث يمثل هذا الجزء
        For I = 2 To UBound(Arr, 1)
'ليساوي المصنف الجديد [WB] تعيين المتغير
           Set WB = Workbooks.Add
'بدء التعامل مع المصنف الجديد
           With WB
'إضافة ورقة عمل باسم "ملاحظات" ، ووضع البيانات المرتبطة من العمود التاسع بالمصفوفة
               With .Sheets.Add
                   .Name = "ملاحظات"
                   .Range("A1") = "ملاحظات"
                   .Range("B1") = Arr(I, 9)
                   .Columns.AutoFit
               End With
'إضافة ورقة عمل باسم "الأداء والمعلومات المالية" ، ووضع البيانات المرتبطة من العمود الرابع والسابع والثامن بالمصفوفة
               With .Sheets.Add
                   .Name = "الأداء والمعلومات المالية"
                   .Range("A1").Resize(3, 1) = Application.Transpose(Array("التقييم السنوي", "الراتب", "البدلات"))
                   .Range("B1") = Arr(I, 4)
                   .Range("B2") = Arr(I, 7)
                   .Range("B3") = Arr(I, 8)
                   .Columns.AutoFit
               End With
'إضافة ورقة عمل باسم "المعلومات الأساسية" ، ووضع البيانات المرتبطة من العمود الأول والثاني والثالث والخامس بالمصفوفة
               With .Sheets.Add
                   .Name = "المعلومات الأساسية"
                   .Range("A1").Resize(5, 1) = Application.Transpose(Array("اسم الموظف", "تاريخ التعيين", "الجنسية", "الوحدة", "الشعبة"))
                   .Range("B1") = Arr(I, 1)
                   .Range("B2") = Arr(I, 2)
                   .Range("B3") = Arr(I, 3)
                   .Range("B4") = Arr(I, 5)
                   .Range("B5") = Arr(I, 6)
                   .Columns.AutoFit
               End With
'وهي ورقة عمل افتراضية في أي مصنف جديد [Sheet1] حذف ورقة العمل المسماة
               .Sheets("Sheet1").Delete
'حفظ المصنف الجديد في نفس مسار المصنف الحالي باسم البيان الموجود في العمود الأول بالمصفوفة
               .SaveAs ThisWorkbook.Path & "\" & Arr(I, 1) & ".xlsx"
'إغلاق المصنف الجديد الذي تم حفظه
               .Close
           End With
'الانتقال لصف جديد والتعامل مع مصنف جديد
    Next I
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
'رسالة تفيد بانتهاء عمل الكود
    MsgBox "Done !", vbInformation
End Sub

وفي انتظار مساهمتك يا باشمهندس .. زيادة الخير خيرين ..

تقبلوا تحياتي :fff: :fff: :fff:

Split Data Into Mulptiple Workbooks YasserKhalil.rar

  • Like 2
رابط هذا التعليق
شارك

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

 

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

 

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

  • Like 1
رابط هذا التعليق
شارك

حبيبي في الله ومعلمي باشمهندس طارق

يكفينا منك مرورك العطر وأعانك الله ووسع دارك وبارك الله في رزقك وأهلك ومالك

 

أخي الكريم المنار

الحمد لله أن تم المطلوب على خير

كمل جميلك وحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

رابط هذا التعليق
شارك

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

 

و استفسار في حالة كان لديك حوالي 70 متغيرلازم تربط كل واحدة بكود

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

أخي الفاضل

حضرتك طرحت ملف مرفق وشكل للنتائج المتوقعة وتم العمل على هذا الأساس ..

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

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

 

بالنسبة لسؤالك لو كان فيه تنسيق معين (فورمات جاهزة) هل تقصد أن هناك مصنف جاهز لعملية الإدخال أم أن هناك مصنفات بالفعل لكل موظف ؟ ولما لم تنوه عن ذلك في الموضوع من البداية

ماذا تقصد بـ 70 متغير ؟هل تقصد 70 بيان في 70 عمود أم ماذا؟

رابط هذا التعليق
شارك

السلام عليكم إخوتي الكرام ...أخي الحبيب ياسر أبو البراء

من محبتي لكم فإنني أتابع أعمالكم وآخر إنجازاتكم...وأنا أعتذر مقدماً على تطفلي على أناس بلغوا شأناً عظيماً بالعلم والمعرفة

لقد نزلت الملف المذكور بعدأن اختيرت أفضل إجابة وجربته إلا أنه أعطاني :

Run-time error '9' Subscript out of range  فما السبب برأيكم؟. علماً أنني فككت الضغط عن الملف .

ملاحظة: تم إعطاء الاسم الأول فقط .

أكرر اعتذاري لأخوتي الذين أرجو الله لهم خيري الدنيا والآخرة.

أخوكم أبو يوسف.

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

أخي الغالي أبو يوسف

ما السطر الذي يحدث عنده خطأ ؟ وما هي نسخة الأوفيس التي تعمل عليها ؟

 

الأخ الكريم المنار

أحسنت في فكرة تقديم موضوع جديد ..

هل كنت فعلاً أنه يمكن معالجة الأمر بدون برمجة !! المعادلات عملها محدود للغاية ، بينما البرمجة تفتح لك آفاقاً واسعة

في الملف المرفق يتم إنشاء مصنفات جديدة وأوراق عمل داخل المصنفات وإغلاق وحفظ هذه المصنفات بالإضافة إلى إدراج بيانات بها ...فكيف للمعادلات أن تقوم بمثل تلك الخطوات ؟؟

  • Like 1
رابط هذا التعليق
شارك

أخي الغالي أبو يوسف

ما السطر الذي يحدث عنده خطأ ؟ وما هي نسخة الأوفيس التي تعمل عليها ؟

 

الأخ الكريم المنار

أحسنت في فكرة تقديم موضوع جديد ..

هل كنت فعلاً أنه يمكن معالجة الأمر بدون برمجة !! المعادلات عملها محدود للغاية ، بينما البرمجة تفتح لك آفاقاً واسعة

في الملف المرفق يتم إنشاء مصنفات جديدة وأوراق عمل داخل المصنفات وإغلاق وحفظ هذه المصنفات بالإضافة إلى إدراج بيانات بها ...فكيف للمعادلات أن تقوم بمثل تلك الخطوات ؟؟

يا من فهّم سليمان فهمنا ...ويا من علم داود علمنا ...اللهم علمنا ما ينفعنا وانفعنا بماعلمتنا ...آمين

العلم من الصغر كالنقش في الحجر والعلم في الكبر كوخز الأبر.....يمكن راحت علينا...ختيرنا...

  • Like 1
رابط هذا التعليق
شارك

أخي الحبيب أبو يوسف

جرب التعديل البسيط في الكود

Sub SplitWB()
'يقوم الكود بفصل بيانات كل موظف في مصنف جديد مقسم إلى أوراق عمل جديدة
'--------------------------------------------------------------------
'تعريف المتغيرات
    Dim WB As Workbook
    Dim Arr
    Dim I As Long
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
'تعيين قيمة للمتغير ليساوي كل القيم في النطاق الحالي في ورقة العمل
'المتغير يخزن البيانات على شكل مصفوفة
        Arr = ThisWorkbook.Sheets("Sheet1").Cells(1).CurrentRegion.Value
'حلقة تكرارية من الصف الثاني وحتى آخر صف به بيانات
'الحد الأعلى للبعد الأول للمصفوفة ألا وهو بعد الصفوف [UBound(Arr, 1)] حيث يمثل هذا الجزء
        For I = 2 To UBound(Arr, 1)
'ليساوي المصنف الجديد [WB] تعيين المتغير
           Set WB = Workbooks.Add
'بدء التعامل مع المصنف الجديد
           With WB
'إضافة ورقة عمل باسم "ملاحظات" ، ووضع البيانات المرتبطة من العمود التاسع بالمصفوفة
               With .Sheets.Add
                   .Name = "ملاحظات"
                   .Range("A1") = "ملاحظات"
                   .Range("B1") = Arr(I, 9)
                   .Columns.AutoFit
               End With
'إضافة ورقة عمل باسم "الأداء والمعلومات المالية" ، ووضع البيانات المرتبطة من العمود الرابع والسابع والثامن بالمصفوفة
               With .Sheets.Add
                   .Name = "الأداء والمعلومات المالية"
                   .Range("A1").Resize(3, 1) = Application.Transpose(Array("التقييم السنوي", "الراتب", "البدلات"))
                   .Range("B1") = Arr(I, 4)
                   .Range("B2") = Arr(I, 7)
                   .Range("B3") = Arr(I, 8)
                   .Columns.AutoFit
               End With
'إضافة ورقة عمل باسم "المعلومات الأساسية" ، ووضع البيانات المرتبطة من العمود الأول والثاني والثالث والخامس بالمصفوفة
               With .Sheets.Add
                   .Name = "المعلومات الأساسية"
                   .Range("A1").Resize(5, 1) = Application.Transpose(Array("اسم الموظف", "تاريخ التعيين", "الجنسية", "الوحدة", "الشعبة"))
                   .Range("B1") = Arr(I, 1)
                   .Range("B2") = Arr(I, 2)
                   .Range("B3") = Arr(I, 3)
                   .Range("B4") = Arr(I, 5)
                   .Range("B5") = Arr(I, 6)
                   .Columns.AutoFit
               End With
'وهي ورقة عمل افتراضية في أي مصنف جديد [Sheet1] حذف ورقة العمل المسماة
               .Sheets("Sheet1").Delete
'حفظ المصنف الجديد في نفس مسار المصنف الحالي باسم البيان الموجود في العمود الأول بالمصفوفة
               .SaveAs ThisWorkbook.Path & "\" & Arr(I, 1) & ".xlsx"
'إغلاق المصنف الجديد الذي تم حفظه
               .Close
           End With
'الانتقال لصف جديد والتعامل مع مصنف جديد
    Next I
    Application.DisplayAlerts = True
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
'رسالة تفيد بانتهاء عمل الكود
    MsgBox "Done !", vbInformation
End Sub

تم إضافة سطرين لإلغاء رسائل التنبيه وإعداة تفعيلها بعد انتهاء الكود

الغريب أن الكود يعمل معي بدون رسالة الخطأ وعلى نفس النسخة 2007

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم أخي أبو البراء الغالي:

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

نظرت إلى أمر لم يكن بالحسبان لدي .Sheets("Sheet1").Delete حيث أن أسماء الأوراق لدي بالعربية

أصبحت كما يلي:  ("ورقة 1") بدلاً من ("sheet1").وقد نجحت المحاولة نجاحاً باهراً....

تهانينا لكم على هذا العمل الررائع

والسلام عليكم.

تم تعديل بواسطه محمد حسن المحمد
  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information