وادي سلي قام بنشر مايو 15, 2020 مشاركة قام بنشر مايو 15, 2020 السلام عليكم إخواني أهل المنتدى أريد دالة نسخ القيمة من الصفحة الأولى إلى الصفحة الثانية على حسب صاحب المشروع كما هو موضح في الملف المشاريع.xlsx رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مايو 15, 2020 مشاركة قام بنشر مايو 15, 2020 جرب هذا الملف الكود Option Explicit Sub transfer_data() Dim S1 As Worksheet, S2 As Worksheet Dim Rg1 As Range Set S1 = Sheets("ورقة1"): Set S2 = Sheets("ورقة2") If S2.Range("A1").CurrentRegion.Rows.Count > 1 Then _ S2.Range("A1").CurrentRegion.Offset(1) _ .Resize(S2.Range("A1").CurrentRegion.Rows.Count - 1).Clear Set Rg1 = S1.Range("A1").CurrentRegion If Rg1.Rows.Count = 1 Then Exit Sub Set Rg1 = Rg1.Offset(1).Resize(Rg1.Rows.Count - 1) Rg1.Columns(2).Copy S2.Range("A2").PasteSpecial Paste:=xlPasteValues, Transpose:=True Application.CutCopyMode = False With S2.Range("A1").CurrentRegion.Rows(2) .InsertIndent 1: .Borders.LineStyle = 1 .Font.Size = 14: .Font.Bold = True .Interior.ColorIndex = 19: .Cells(1, 1).Select End With End Sub الملف مرفق Mashri3.xlsm 3 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر مايو 15, 2020 مشاركة قام بنشر مايو 15, 2020 بعد اذن استاذنا سليم ولإثراء الموضوع ,,فهذا حل ايضا بمعادلة المصفوفة =IFERROR(INDEX(ورقة1!$C:$C,SMALL(IF(ورقة1!$B:$B=A$2,ROW(A$2:A$5000)-ROW(A$2)+1),ROWS($A$5:A5))),"") المشاريع1.xlsx 6 رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر مايو 15, 2020 أفضل إجابة مشاركة قام بنشر مايو 15, 2020 ربما ينال الاعجاب هذا الملف 1-لا يتم تكرار الأسماء 2-تحديد المجموع لكل اسم الكود Sub transfer_data_with_sum() Dim S1 As Worksheet, S2 As Worksheet Dim Rg1 As Range, x As Range Dim Dic As Object Set S1 = Sheets("ورقة1"): Set S2 = Sheets("ورقة2") If S2.Range("A1").CurrentRegion.Rows.Count > 1 Then _ S2.Range("A1").CurrentRegion.Offset(1) _ .Resize(S2.Range("A1").CurrentRegion.Rows.Count - 1) _ .Clear Set Dic = CreateObject("Scripting.Dictionary") Set Rg1 = S1.Range("A1").CurrentRegion If Rg1.Rows.Count = 1 Then Exit Sub Set Rg1 = Rg1.Offset(1).Resize(Rg1.Rows.Count - 1) For Each x In Rg1.Columns(2).Cells Dic(x.Value) = Val(Dic(x.Value)) + Val(x.Offset(, 1)) Next x If Dic.Count = 0 Then Exit Sub With S2.Range("B2").Resize(, Dic.Count) .Value = Dic.keys .Offset(1) = Dic.Items End With S2.Range("A2") = "الإسم": S2.Range("A3") = "المجموع" With S2.Range("a2").Resize(2, S2.Range("A1").CurrentRegion.Columns.Count) .InsertIndent 1: .Borders.LineStyle = 1 .Font.Size = 14: .Font.Bold = True .Rows(1).Interior.ColorIndex = 19 .Rows(2).Interior.ColorIndex = 28 End With End Sub الملف مرفق Mashri3 _with_Sum.xlsm 3 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.