الـعيدروس

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

وهذا لتأكيد عمل الكود جرب هذا نفس الكود ولاكن ينفذ الصيغة على المدى Public Sub alidroos_CP_SU_F() With ورقة1 For ALI_SUM = 3 To 28 .Cells(17, ALI_SUM).Formula = "=SUMPRODUCT((Name=$B$17)*(Month=" & .Cells(1, ALI_SUM).Address(True, False) & ")*Madine)" Next ALI_SUM End With End Sub

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

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

السلام عليكم جرب هذا الكود Public Sub alidroos_CP_SU() ZZ = Cells(Rows.Count, 1).End(xlUp).Row + 1 Cells(ZZ, 1) = Application.WorksheetFunction.Sum(Range([A2], Cells(ZZ, 1))) End Sub

السلام عليكم جرب هكذا Public Sub alidroos_CP_SU() For ALI_SUM = 3 To 28 Cells(17, ALI_SUM).Value = Evaluate("=SUMPRODUCT((Name=$B$17)*(Month=" & Cells(1, ALI_SUM).Address(False, True) & ")*Madine)") Next ALI_SUM End Sub

السلام عليكم حط هذا الكود في حدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 25 Or Target.Row < 5 Then Exit Sub If Target.Value = Empty Then Exit Sub If Not Intersect(Target, Range("Y5:Y25")) Is Nothing Then Application.ScreenUpdating = False Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets If sh.Name = "الوكلاء" Then GoTo 2 If Target.Value <> Empty Then If Month(Target.Offset(0, -3).Value) = sh.Name Then Target.Offset(0, -3).Resize(1, 4).Copy QQ = sh.Cells(1000, 14).End(xlUp).Row + 1 sh.Range("N" & QQ).PasteSpecial xlPasteValues End If End If 2 Next End If Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

السلام عليكم المخرجات نفس الشروط اين المشكلة J7 الخميس 6:00 J8 الجمعه 00:00 باقي الايام 8:30 نو بربلم تحياتي

عفوا تفضل هكذا Public Sub alidroos() Application.ScreenUpdating = False Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets For R = 5 To 25 If sh.Name = "الوكلاء" Then GoTo 2 If Cells(R, "V").Value <> Empty Then If Month(Cells(R, "V").Value) = sh.Name Then Range(Cells(R, "V"), Cells(R, "Y")).Copy QQ = sh.Cells(1000, "N").End(xlUp).Row + 1 sh.Range("N" & QQ).PasteSpecial xlPasteValues End If End If Next 2 Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

السلام عليكم الاخ الفاضل tahar1983 انقر على موافق وخش على قائمة الفيجول ربما بعض المكاتب مفقودة عندك عشان كذا لم يتعرف على كود حجم الشاشة اضن وتأكد من قائمة References اذا كانت القائمة محفزة على احد الخيارات حاول تلغي التحفيز وموافق وجرب ان شاء الله يزبط معاك هذا والله اعلم

السلام عليكم هذا الكود في حال المدى في الملف الاصلي مثل بعض في كل الاوراق Sub ali1() On Error Resume Next Application.DisplayAlerts = False Dim M_ALI As Worksheet, T_ALI As Variant Set M_ALI = ActiveWorkbook.Worksheets(1) T_ALI = Array("الوكلاء", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12") Worksheets(T_ALI).FillAcrossSheets M_ALI.Range(Cells(5, 22), Cells(25, 25)), xlFillWithAll End Sub وهذا الكود على حال الملف الحالي Sub ali_1() Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets If sh.Name = "الوكلاء" Then GoTo 0 With sh .Application.ScreenUpdating = False ورقة1.Range(Cells(5, 22), Cells(25, 25)).Copy XXX = .Cells(100, 14).End(xlUp).Row + 1 .Range("N" & XXX).PasteSpecial xlPasteValues .Application.CutCopyMode = False End With 0 Next sh End Sub والسلام عليكم

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

السلام عليكم اطلع على المرفق SH_ALI_M.rar

ممكن تسوي Prtscn للصورة الله لايهينك وترفقها

السلام عليكم انا مجرب بتشتغل فيه الاكواد طبيعي ماالمشكلة التي تظهر عندك ؟؟ استخدم هذا الكود للرجوع من اي ورقة للورقة الاولى Sub ali() Sheets(1).Select End Sub

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

وعليكم السلام ورحمة الله وبركاتة هكذا المبادئ ولا فلا جزاك الله خير استاذ احمد أنت أبو الكرم مايقارب 3000 مشاركة ان دل انما يدل على عطاء لا حدود والدرس فهم جعله الله في موازين حسناتك تقبل تحياتي وشكري تلميذك أبو نصار

السلام عليكم جزاك الله كل خير استاذنا الحبيب احمد يعقوب طريقة سهله ولاكن لم افهم معناها نتيجة قوية استفسار استاذ احمد مامعنى علامة الدولار قبل المرجع C$

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

السلام عليكم الغيت المعادلة ويتم الجمع عن طريق الكود مجرد تسجيل المبلغ جرب وابلغني بالنتيجة CRET_ALI.rar

اشكرك على كلماتك الطيبه احبك الله الذي احببتنا فيه

السلام عليكم الاخ الفاضل ابو الحسن حفظك الله طلبك فيه نوع من اللفه الطويلة تم عمل طلبك من عمل سابق ويؤدي نفس الغرض ان شاء الله يفي بالغرض جرب واخبرني بالنتيجة alidroos_SH_S.rar

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

يعني تريد يعمل عندم تقوم بإدخال عدد جديد ام ماذا ؟؟؟

السلام عليكم المعادلة بتظهر 10 نفس ماهو في مبيعات الفرع عمود D صف رقم 6 اين المشكلة ؟؟