GasserReda

تفضل أستاذ ابو سليمان حدد اي خلية ونفذ الامر Book1.rar

الأخ الصقر أعتقد أن الكود بها الشكل سيشكل إرهاقا في حالة العمل في ورقة العمل حيث أن الحدث يعمل في حالة تحديد أي خلية ..يمكن تقنين الكود بهذا الشكل بحيث يعمل فقط في حالة تحديد أي خلية في خلايا النطاق المطلوب Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set Rng = Union(Range("F4:F7"), Range("G4:G7"), Range("I4:I7")) If Not Intersect(Target, Rng) Is Nothing Then With Sheets("XYZ").Range("F4:F7") .Formula = "=SUMIF($B$4:$C$14,E4,$C$4:$C$14)" .Value = .Value End With With Sheets("XYZ").Range("G4:G7") .Formula = "=COUNTIF($B$4:$B$14,E4)" .Value = .Value End With With Sheets("XYZ").Range("I4:I7") .Formula = "=VLOOKUP(E4,$E$4:$H$7,4,0)" .Value = .Value End With End If End Sub

قم بوضع الكود في sheet1_module Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Not Intersect(Target, Range("C16")) Then Cancel = True lastr = Range("D15").End(xlUp).Row + 1 Cells(lastr, 4).Value = Range("C16").Value End If End Sub دبل كليك في الخلية C16 ليقوم الكود بالعمل

قم بحفظ المصنف بالامتداد Macro-Enabled لتتمكن من الاحتفاظ بالدالة حيث أن الدالة يطلق عليها User Defined Function أو دالة معرفة قم بوضع الدالة في محرر الأكواد ثم حفظ باسم واختار Macro-Enabled ليتم حفظ المنصف بالامتداد xlsm وشكرا

تفضل جرب الملف المؤهل العلمي.rar

جرب المرفق التالي xx.rar

في الإجراء الفرعي الثاني أضف هذا السطر Application.DisplayStatusBar = False

ActiveCell.Resize(, 5).Select جرب هذا السطر ، قم بتحديد أي خلية ثم نفذ هذا السطر ، سيقوم بتحديد الخلية النشطة ومعها 4 خلايا أخرى

If sh.Name <> "ورقة1" And sh.Name <> "أي ورقة" Then يمكنك التغيير في هذا السطر وزيادة عدد الأوراق التي تريد عدم تطبيق الكود بها ، كلمة أي ورقة مثال فقط استبدلها باسم الورقة التي تريد عدم تطبيق الكود بها ما المقصود بكلمة كامل الشريط

جرب هذا الكود Sub sumall() Dim lastr As Long Dim sh As Worksheet For Each sh In Worksheets If sh.Name <> "ورقة1" Then lastr = sh.Cells(Rows.Count, 1).End(xlUp).Row With sh.Range("C1:C" & lastr) .Formula = "=SUM(A1:B1)" End With End If Next sh End Sub

بارك الله فيكي ممكن مثال تطبيقي على الإكسيل نفسه لمزيد من الاستفادة وشكرا