محتاج مساعدة في مشروعي

[Ambiguooous]

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

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

1- عندي الشيت الرئيسي للتسجيل اليومي (مو شيت وحدة راح تكون أكثر من شيت)  (وراح يكون كل شيت باسم العميل customer1 customer2  الى مالانهاية على حسب عدد العملاء) 

2- شيت summary وهذي الشيت تجمع لي (بشكل عمودي) كل الجداول اللي راح تكون في شيت كل عميل بحيث يخلص العميل الاول ويجي بعده العميل الثاني وبعده الثالث وهكذا 

3- شيت Customers عبارة عن قائمة العملاء اللي ياح يكونوا عندي بالتفاصيل اللي المفروض تقرأ من كل شيت لعميل 

4- شيت Products عبارة عن قائمة من المنتجات اللي اللي عندي بتفاصيلها (الكود ، الاسم ، التصنيف ، السعر) بالاضافة كم المستخدم في كل واحد 

 

اللي احتاجه هو شيت رقم 2 وشيت رقم 3 وشيت رقم 4 كيف أقدر أخلي الشغل فيهم يكون أوتو  .. وش ممكن تكون الأفكار اللي أقدر أستخدمها 

 

شاكر ومقدر لكل واحد يدخل ويضيف أي فكرة حتى لو كانت صغيرة وراح أكون ممنون لأي واحد يقدر يجي معاي وحبة حبة نوصل للي أريده في النهاية 😊

 

المرفق يحاكي المشروع  

My project.xlsx

 

[سليم حاصبيا]

جرب هذا الكود

Option Explicit
Sub get_data()
Application.ScreenUpdating = False
Dim S As Worksheet
Dim Cus As Worksheet
Dim m%: m = 3
Dim R%
Set S = Sheets("Summary")
With S
  .Cells.Clear
     For Each Cus In Sheets
        If Cus.Name Like "Customer" & "#" Then
        R = Cus.Range("B9").CurrentRegion.Rows.Count
        Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1)
         With .Cells(m - 1, 1)
         .Value = Cus.Name
         .Interior.ColorIndex = 6
         End With
          m = m + R + 2
        End If
     Next Cus
  .Range("C:C,D:D,H:H").EntireColumn.Delete
 End With
 Application.ScreenUpdating = True
End Sub

الملف مرفق

 

My project.xlsm

[Ambiguooous]

أخي وأستاذي  سليم حاصبيا الله يعطيك كل الصحة والعافية يارب ويرفع من شانك .. الشغل جدا ممتاز بس عندي كم سؤال لو بغيت أغير في الأعمدة اللي راح تجي مع في التقرير هذا وين أغير بالضبط في الكود ؟ وبالنسبة لأسماء الشيت لو راح أغيرهم لاسم العميل نفسه بدلا من customer1 customer2 وكذا .. كيف الطريقة ووين المفروض أغير في الكود ؟ 

* وبالنسبة ل شيت  Customers وش أسهل طريقة أخليه يقرأ من كل شيت ويأخذ لي المعلومات من الجدول الاصفر في كل شيت ؟

* وبالنسبة ل شيت Products أحتاج أنه يعطيني كل منتج كم المستخدم منه والسعر لكل واحد  ؟

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

شباب أهل الخبرة في Pivot Table  كيف ممكن يفيدني في هذا المشروع ؟

[Ambiguooous]

سوري بس أنا مو عارف النظام في المنتدى .. الحين تأشر على الموضوع "تمت الاجابة" بينما أنا عندي استفسارات ثانية وطلبات (ذكرت في أصل الموضوع) لسه مش عارف اعملها  !!  اعمل موضوع جديد يعني أو نكمل هنا أو كيف  

[سليم حاصبيا]

جرب هذا الملف

 

My project_new.xlsm

[Ambiguooous]

ماشاء الله تبارك الله عليك  شغل جبار ياأستاذ  

 

بصراحة بديت اشتغل عليه واعمل تست بس مش عارف اكمل (أبي أغير في الأعمدة اللي اسحبهم معاي أو أضيف صفحات زيادة لعملاء جدد) مش عارف بالضبط وين المفروض أعدل .. ممكن تشرح لي وين بالضبط أعدل على الكود  ؟؟؟

 

Option Explicit
Sub get_data()
Application.ScreenUpdating = False
Dim S As Worksheet
Dim Cus As Worksheet
Dim m%: m = 3
Dim R%
Dim ar_sh(1 To 3)
'ÇÖÝ Çáì åÐå ÇáãÕÝæÝÉ ÇáÕÝÍÇÊ ÇáÊí áÇ ÊÑíÏ Çä íÊÚÇØì ãÚåÇ ÇáãÇßÑæ
ar_sh(1) = "Summary": ar_sh(2) = "Customers": ar_sh(3) = "Products"
Set S = Sheets("Summary")
With S
  .Cells.Clear
     For Each Cus In Sheets
     If IsError(Application.Match(Cus.Name, ar_sh, 0)) Then
        R = Cus.Range("B9").CurrentRegion.Rows.Count
        Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1)
         With .Cells(m - 1, 1)
         .Value = Cus.Name
         .Interior.ColorIndex = 6
         End With
          m = m + R + 2
        End If
     Next Cus
  .Range("C:C,D:D,H:H").EntireColumn.Delete
 End With
End Sub


=======================================

Option Explicit
Sub Fil_data()
Application.ScreenUpdating = False
Dim My_sh As Worksheet
Dim Cus As Worksheet
Dim m%: m = 2
Dim col%
Dim ar_sh(1 To 3)

'ÇÖÝ Çáì åÐå ÇáãÕÝæÝÉ ÇáÕÝÍÇÊ ÇáÊí áÇ ÊÑíÏ Çä íÊÚÇØì ãÚåÇ ÇáãÇßÑæ
ar_sh(1) = "Summary": ar_sh(2) = "Customers": ar_sh(3) = "Products"
Set My_sh = Sheets("Customers")
With My_sh
  .Range("a1").CurrentRegion.Offset(1).ClearContents
     For Each Cus In Sheets
     If IsError(Application.Match(Cus.Name, ar_sh, 0)) Then
     col = Cus.Cells(6, Columns.Count).End(1).Column
     .Cells(m, 1).Resize(, col).Value = _
     Cus.Cells(6, 2).Resize(, col).Value
     m = m + 1
        End If
     Next Cus
'  .Range("C:C,D:D,H:H").EntireColumn.Delete
 End With
End Sub

 

وبالنسبة لشيت ال products ماعملنا عليها حاجة  ..  عاوز يجيب لي جميع ال ال products في جميع شيت اللي باسم العملاء ويعطيني المجموع حقهم (sum لكل product) 

[Ambiguooous]

[سليم حاصبيا]

صباح الثورة من بيروت/صيدا/النبطية/صور /طرابلس .....ومن كل شبر من أرض لبنان الحبيب

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

للتحكم بالاعمدة التي لا تريد اظارها يمكن معالجة ذلك من خلال تغيير المعطيات في الكود (ما بين علامات ++++++)

Option Explicit
Sub get_data_new()
Application.ScreenUpdating = False
Dim S As Worksheet
Dim Cus As Worksheet
Dim m%: m = 3
Dim LG
Dim R%
Set S = Sheets("Summary")
With S
  .Cells.Clear
     For Each Cus In Sheets
        If Cus.Name Like "Customer" & "#" Then
        R = Cus.Range("B9").CurrentRegion.Rows.Count
        Cus.Range("B9").CurrentRegion.Copy .Cells(m, 1)
         With .Cells(m - 1, 1)
         .Value = Cus.Name
         .Interior.ColorIndex = 6
         End With
      
       LG = .Cells(Rows.Count, "g").End(3).Row
    With .Cells(LG + 1, 6).Resize(, 2)
     .Columns(1) = "SUM:"
     .Columns(2).Formula = _
      "=SUM(G" & m + 1 & ":G" & LG & ")"
     .Interior.ColorIndex = 3
     .Font.Color = vbWhite
     .Value = .Value
     End With
          m = m + R + 2
        End If
     Next Cus
     '+++++++++++++++++++++++++++++
  .Range("C:C,D:D,H:H").EntireColumn.Delete
     '+++++++++++++++++++++++++++++
     .Range("E:E").NumberFormat = "#,##0"
 End With
 Application.ScreenUpdating = True
End Sub

الملف بعد التعديل

 

My project_SALIM.xlsm

[Ambiguooous]

الله يعطيك العافية بس اللي بغيته هو كالاتي :  (يسرد ال products الموجودة عند كل العملاء بشكل تجميعي) 

[Ambiguooous]

6 ساعات مضت, Ambiguooous said:

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

[سليم حاصبيا]

الحرف   m  هو رقم الصف الدي ستبدأ به البيانات في صفحة Summary

التسلسل 1     to   3  to   الرقم 3  عدد الصفحات التي يجب على الكود ان لا يتعاطى معها  لاننا  نريد استثناءها من عمل الكود (Summary /ٍCustomers / Products)

R هو عدد الصفوف الممتلئة في كل صفحة ابتداءً من الخلية B9

B9 بداية البيانات في كل صفحة

الرقم 6 يدل على اللون الاصفر

"H:H,D:D, C:C" الأعمدة التي لا حاجة لها(يتم مسحها)