طلب كود لنسخ البيانات من جميع الصفحات الى صفحه اجماليه

[إبراهيم محمد]

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

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

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

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

مرفق ملف كمثال للعمل عليه مع العلم بانه يمكن ان يكون عدد الصفحات يتجاوز 100 صفحه وعدد الصفوف فى كل صفحه قد يتجاوز 2000 صف

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

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

نسخ بيانات جميع الصفحات.rar

[الـعيدروس]

السلام عليكم

جرب هذا الكود

Private Const Sn As String = "total"

Public Sub Ali_Al_Sh()

Dim Sh As Worksheet

Dim Cn

La = Sheets(Sn).Cells(Rows.Count, 3).End(xlUp).Row

Sheets(Sn).Range("B5:H" & IIf(La = 4, 5, La)).ClearContents

For Each Sh In ThisWorkbook.Worksheets

With Sh

Select Case Sh.Name

	   Case Is = Sn

	   Case Else

	   Cn = Sheets(Sn).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row

	   Lr = .Cells(Rows.Count, 3).End(xlUp).Row

	   .Range(.Cells(5, 2), Sh.Cells(Lr, 8)).Copy

	   Sheets(Sn).Cells(Cn, 2).PasteSpecial xlPasteValues

End Select

End With

Next

Application.CutCopyMode = False

End Sub

[إبراهيم محمد]

مرحبا بالاستاذ الفاضل والمعلم الكبير

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

وان شاء الله سوف اجرب الكود وارد عليك باذن الله

[إبراهيم محمد]

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

انا جربت الكود وهو شغال بصورة ممتازة جدا وما شاء الله عليك

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

ماذا يعنى الرقم 3 فى هذا الكود هل هو العمود الثالث

ماذا يعنى الرقم 3 هنا

La = Sheets(Sn).Cells(Rows.Count, 3).End(xlUp).Row

Sheets(Sn).Range("B5:H" & IIf(La = 4, 5, La)).ClearContents وماذا تعنى ارقام 4 و 5

وكذلك الاراقام فى باقى اسطر الاكواد

برجاء اعطاء نبذة بسيطه عنها لكي يسهل فهم الكود وتعم الفائدة باذن الله

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

[حمادة عمر]

السلام عليكم

الاستاذ الكبير / عباد

اللهم لا حسد

فأنت باااااااااااااااارع جدااااااااا استاذي القدير

الكود يعمل بكفاءة وجاء في وقته تماما

وشكرا للاخ الكريم / himass علي طرحه للموضوع

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

[إبراهيم محمد]

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

الاستاذ الكبير / ابو نصار المحترم

تكمله بسيطه من علمك الغزير باذن الله

فى برنامج صلاحيات المستخدمين الذى حضرتك انجزته سوف اضع هذا الكود ليقوم بجمع البيانات من جميع الصفحات طبعا ما عدا الورقه الاولى وورقه mydate

فارجوا منك هذا الكود ولك جزيل الشكر والامتنان

مع خالص شكرى وتقديرى واحترامي للاستاذ البارع - ابو نصار

[إبراهيم محمد]

الاخ الفاضل / حمادة عمر

اسعدني مشاركتك ومرورك

وبارك الله فيك

[إبراهيم محمد]

بعد اذن استاذنا العظيم حاولت ان افهم الكود بعض الشىء وقمت باضافه ثوابت للاستثاء الصفحات التى ذكرتها فى المشاركه السابقه وهو كالتالى

Private Const Sn As String = "total"

Private Const Sn1 As String = "MyDate"

Private Const Sn2 As String = "ورقة1"

Public Sub Ali_Al_Sh() 'كود نسخ البيانات من جميع الصفحات الى الصفحه الاجماليه

Dim Sh As Worksheet

Dim Cn

La = Sheets(Sn).Cells(Rows.Count, 3).End(xlUp).Row

Sheets(Sn).Range("B5:H" & IIf(La = 4, 5, La)).ClearContents

For Each Sh In ThisWorkbook.Worksheets

With Sh

Select Case Sh.Name

Case Is = Sn

Case Is = Sn1

Case Is = Sn2

Case Else

Cn = Sheets(Sn).Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row

LR = .Cells(Rows.Count, 3).End(xlUp).Row

.Range(.Cells(5, 2), Sh.Cells(LR, 8)).Copy

Sheets(Sn).Cells(Cn, 2).PasteSpecial xlPasteValues

End Select

End With

Next

Application.CutCopyMode = False

End Sub

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

طبعا على قد مقدرتي وهى لا شىء بجوار علمكم الغزير

بارك الله لك فيه وزادك من فضله