تجميع بيانات الشيتات بصورة متتالية في شيت تجميع واحد

[mohamed elforse]

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

 

اخواني الكرام علماء هذا المنتدي

 

مرفق ملف به مجموعة شيتات

 

المطلوب :

 

كود يقوم بتجميع بيانات الشيتات 1 & 2 & 3 فى شيت " شيت مجمع " بصورة متتالية تحت بعضها مع ذكر اسم الشيت ضمن البيانات مع العلم انه يمكن زيادة الشيتات المطلوب بياناتها باعداد كثيرة

 

مثال:

 

( شيت مجمع ) المرفق في الملف

 

مراكز الخدمات.rar

 

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

[mohamed elforse]

للرفع

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

تفضل أخي الحبيب الملف المرفق..

التجميع سيكون من الشيتات 1 ، 2 ، 3 حسب ما فهمت ..

الكود سيعمل مع الشيتات التي سوف تقوم بترقيمها بشرط تغيير طفيف في الكود .. في الحلفة التكرارية بدلا من 1 إلى 3 ، ستقوم بتغيير آخر رقم لآخر شيت تريد

Sub CollectDataFromSheets()
    Dim I As Long, LR As Long
    Application.ScreenUpdating = False
        Sheets("شيت مجمع").Range("A3:H1000").ClearContents
        For I = 1 To 3
            With Sheets("" & I & "")
                .Activate
                LR = .Cells(300, 2).End(xlUp).Row
                .Range("B5:H" & LR).Copy
                    With Sheets("شيت مجمع")
                    .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial xlPasteValues
                    .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells(Rows.Count, 2).End(xlUp).Row) = Sheets("" & I & "").Name
                    End With
            End With
        Next I
        Sheets("شيت مجمع").Activate: Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Collect Data From Sheets.rar

[mohamed elforse]

اولا:

 

اوجه الشكر والتقدير للاستاذ / yasser khalil

 

علي مجهوداتك الرائعة وعلي وقتك الثمين

 

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

 

ومرفق لسيادتكم مثال

 

Collect Data From Sheets (2).rar

 

ولكم جزيل الشكر والتقدير

 

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

أخي الحبيب أحب أن أنوه إلى قولك

 

كود يقوم بتجميع بيانات الشيتات 1 & 2 & 3 فى شيت " شيت مجمع "

 

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

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

اعتبر هذا لوم وعتاب ، حيث أنك لم توضح المطلوب بشكل جيد .........

 

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

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

أخي الحبيب محمد

تفضل الملف المرفق ...كل ما عليك أن تضع أوراق العمل المطلوب جلب البيانات منها في مصفوفة بالترتيب الذي ترغب التعامل معه

Sub CollectDataFromSheets()
    Dim MyArray As Variant, Item
    Dim LR As Long
    MyArray = Array("خط التعبئة والتغليف", "خط الاستلام والتجهيز", "1", "2", "3")
    Application.ScreenUpdating = False
        Sheets("شيت مجمع").Range("A3:H1000").ClearContents
        
        For Each Item In MyArray
            With Sheets(Item)
                .Activate
                LR = .Cells(300, 2).End(xlUp).Row
                .Range("B5:H" & LR).Copy
                    With Sheets("شيت مجمع")
                    .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial xlPasteValues
                    .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells(Rows.Count, 2).End(xlUp).Row) = Sheets(Item).Name
                    End With
            End With
        Next Item
        
        Sheets("شيت مجمع").Activate: Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

ويتم ذلك من خلال السطر الرابع

إليك الملف المرفق للتجربة

ولا تنسى أن تحدد المشاركة التي تعجبك كأفضل إجابة ليظهر للأخوة الأعضاء أن الموضوع مجاب ، وعشان آخد نقطة (بعد التعب دا كله)

تقبل تحياتي

Collect Data From Sheets V2.rar

[mohamed elforse]

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

اخي الكريم

 

اولا

 

احب ان اعتذر لعدم توضيح المطلوب بدقة

 

ولكن كنت اضرب مثال فقط و الواقع ان اوراق العمل تسمي باسماء و ارقام

 

فارجو تعديل الكود لهذا الغرض

 

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

 

مع تقديري لمجهوداتك ووقتك الثمين

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

المفروض المشاركة دي جاية متأخرة !!! ههههه ولا أنا اللي فاهم غلط

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

تقبل تحياتي ..

[mohamed elforse]

الاخ الكريم ياسر خليل

 

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

 

والكود في غاية الروعة

 

ولكم جزيل الشكر والتقدير

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

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

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

Sub CollectDataFromSheets()
    Dim SH As Worksheet
    Dim LR As Long
    
    Application.ScreenUpdating = False
        Sheets("شيت مجمع").Range("A3:H1000").ClearContents
        
        For Each SH In ThisWorkbook.Worksheets
            If SH.Name <> "بيان اجمالى " And SH.Name <> "بيان اجمالى  شهرى" And SH.Name <> "الترحيل" And SH.Name <> "الصفحة الرئيسية" And SH.Name <> "شيت مجمع" And SH.Name <> "الناسخة" Then
                With SH
                    .Activate
                    LR = .Cells(300, 2).End(xlUp).Row
                    .Range("B5:H" & LR).Copy
                        With Sheets("شيت مجمع")
                            .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).PasteSpecial xlPasteValues
                            .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":A" & .Cells(Rows.Count, 2).End(xlUp).Row) = SH.Name
                        End With
                End With
            End If
        Next
        
        Sheets("شيت مجمع").Activate: Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Collect Data From Sheets V3.rar

[محمد السباعي]

استاذي و معلمي المحترم / ياسر خليل  ابو البراء 

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

اولا انا احبك في الله 

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

ثالثا سؤال هل يمكن ان يتم تنفيذا هذا الكود الرائع  بتحديد تاريخ معين بمعني لايتم تجميع جميع البيانات في كل الايام ولكن تجميع بيانات في يوم  معين يتم اختيارة ؟

ارجو أن يكون الموضوع سهلا و غير شاق عليك  وسامحني اذا كنت اثقلت عليك بهذا السؤال

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

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

أخي الكريم محمد السباعي

أحبك الله الذي أحببتني فيه .. ومشكور على كلماتك الطيبة وجزيت خيراً بمثل ما دعوت لي

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

إن شاء الله كل شيء ممكن ، ممكن ترفق ملفك وحاول توضح المطلوب بشيء من الدقة وإن شاء الله تجد الحل

الفكرة ستكمن في وضع سطر للشرط المطلوب بحيث يتم تجميع البيانات الخاصة باليوم المحدد

وأفضل طرح موضوع جديد لتجد استجابة أفضل من الجميع ، مع وضع الكود الذي يلبي رغبتك من الأكواد الثلاثة المطروحة في الموضوع

[حسين السيد السيد]

الاستاذ المحترم ياسر  خليل ابو البراء

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

ارجو الاهتمام  ولا الشكر

 

تم تعديل ديسمبر 25, 2016 بواسطه hossin2525

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

أخي الكريم
يرجى طرح طلبك في موضوع مستقل حيث أن الطلبات في المشاركات الفرعية لا يلتفت إليها ، وعند طرح الموضوع ارفق ملف موضحاً فيه شكل النتائج المتوقعة ليساعدك الأخوة الكرام في المنتدى ويسهل تقديم المساعدة من الأخوة

تقبل تحياتي