yara ahmed قام بنشر يناير 1, 2021 مشاركة قام بنشر يناير 1, 2021 احتاج مساعدة اخواتى احتاج كود استدعاء بيانات من شيتس الى صفحة تقرير انا فكرت كثير فى تصميم للتقرير وتوصلت الى الموجود بالمرفق يمكن تغير فى التصميم اذا كان هناك حاجة لذلك النتائج المرجو الحصول عليها موجودة بالمرفق حبى وشكرى لكم التقرير النهائى.xlsm رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يناير 2, 2021 مشاركة قام بنشر يناير 2, 2021 الحل هنا Option Explicit Sub My_Data_Sum() Dim Ws As Worksheet Dim Sheets_Names() Dim Client_Name() Dim m%, x%, n%, Ro%, K% Dim Rg_name As Range tak.Cells(2, 2).Resize(500, 8).ClearContents Ro = tak.Cells(Rows.Count, 1).End(3).Row m = -1 For Each Ws In Sheets If UCase(Ws.Name) Like "SH*" Then m = m + 1 ReDim Preserve Sheets_Names(m): Sheets_Names(m) = Ws.Name End If Next Ws x = -1 For n = 2 To Ro If tak.Cells(n, 1) <> vbNullString Then x = x + 1 ReDim Preserve Client_Name(x) Client_Name(x) = tak.Cells(n, 1) End If Next n K = 2 For x = LBound(Client_Name) To UBound(Client_Name) For m = LBound(Sheets_Names) To UBound(Sheets_Names) Set Ws = Sheets(Sheets_Names(m)) Set Rg_name = Ws.Range("A:A").Find(Client_Name(x), lookat:=1) If Not Rg_name Is Nothing Then tak.Cells(K, 3).Resize(, 6).Value = _ Rg_name.Offset(1, 1).Resize(, 6).Value tak.Cells(K, 2) = Sheets_Names(m) tak.Cells(K, "I") = _ Application.Sum(tak.Cells(K, 3).Resize(, 6)) End If K = K + 1 Next m Next x Erase Sheets_Names: Erase Client_Name: Set Ws = Nothing End Sub Final_repory_yara.xlsm 2 1 رابط هذا التعليق شارك More sharing options...
yara ahmed قام بنشر يناير 2, 2021 الكاتب مشاركة قام بنشر يناير 2, 2021 والله العظيم تحفة جدا اجمل مما كنت اتخيل وعمرى ماكنت اتخيل التقرير بالجمال ده تسلم وتعيش اخويا الغالى سليم حاصبيا ليا طلب اخير عايزة جمع للاعمدة فى اخر صف وتنسيق الجدول الكود يعمله الف شكر ربنا ما يحرمنى منك ابدااااااااااااااااا رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر يناير 2, 2021 أفضل إجابة مشاركة قام بنشر يناير 2, 2021 هذا الكود للنتسيق العامود B في الصفحة الأولى بجب ان يكون فارغاً كلياُ (تم اخفاءه لعدم الكتابة فيه غن طريق الخطأ) Option Explicit Sub My_Data_Sum() Dim Ws As Worksheet Dim Sheets_Names() Dim Client_Name() Dim m%, x%, n%, Ro%, K% Dim Rg_name As Range Dim First_All As Range, MMax% Set First_All = tak.Range("C1").CurrentRegion MMax = First_All.Rows.Count If MMax > 1 Then First_All.Offset(1).Resize(MMax).Clear End If Ro = tak.Cells(Rows.Count, 1).End(3).Row m = -1 For Each Ws In Sheets If UCase(Ws.Name) Like "SH*" Then m = m + 1 ReDim Preserve Sheets_Names(m): Sheets_Names(m) = Ws.Name End If Next Ws ' x = -1 For n = 2 To Ro If tak.Cells(n, 1) <> vbNullString Then x = x + 1 ReDim Preserve Client_Name(x) Client_Name(x) = tak.Cells(n, 1) End If Next n ' K = 2 For x = LBound(Client_Name) To UBound(Client_Name) For m = LBound(Sheets_Names) To UBound(Sheets_Names) Set Ws = Sheets(Sheets_Names(m)) Set Rg_name = Ws.Range("A:A").Find(Client_Name(x), lookat:=1) If Not Rg_name Is Nothing Then tak.Cells(K, 4).Resize(, 6).Value = _ Rg_name.Offset(1, 1).Resize(, 6).Value tak.Cells(K, 3) = Sheets_Names(m) tak.Cells(K, "J") = _ Application.Sum(tak.Cells(K, 4).Resize(, 6)) End If K = K + 1 Next m Next x If K > 2 Then With tak.Range("C2").Resize(K - 1, 8) .Borders.LineStyle = 1 .HorizontalAlignment = 3 .Font.Bold = True .Font.Size = 14 End With With tak .Cells(K, 3) = "Sum" .Cells(K, 4).Resize(, 7).Formula = _ "=SUM(D2:D" & K - 1 & ")" .Cells(K, 3).Resize(, 7) _ .Interior.ColorIndex = 40 .Cells(K, "J").Interior.ColorIndex = 3 .Cells(K, "J").Font.ColorIndex = 2 With .Range("C1").CurrentRegion .Value = .Value For x = 2 To K If .Cells(x, 1).Offset(, -2) <> "" Then .Cells(x, 1).Resize(, 8).Interior.ColorIndex = 35 End If Next End With End With End If Erase Sheets_Names: Erase Client_Name Set Rg_name = Nothing: Set First_All = Nothing Set Ws = Nothing End Sub Final_report_yara.New.xlsm 3 رابط هذا التعليق شارك More sharing options...
yara ahmed قام بنشر يناير 2, 2021 الكاتب مشاركة قام بنشر يناير 2, 2021 الله يعزك بين العباد هذا ضرب من الخيال والله انت مدهش ربنا يبارك لك فى حياتك يارب كل شئ ممتاز ربنا يسلمك يارب من اى شر ويديك الصحة والعافية ودائما فى تقدم يارب انا متشكرة جداااااااااااااااااااااااااااااااااااااااااااا رابط هذا التعليق شارك More sharing options...
الردود الموصى بها