عمل مجموع جدول

[مهند الزيدي]

السلام عليكم .. أعزائي ..

ممكن عمل الموجود داخل المرفق...جزاكم الله خيرا

مجموع جدول.zip

[ياسر خليل أبو البراء]

الأخ الفاضل مهند

إليك الكود التالي .. يراعى أخذ مسافة بين كلمة مجموع والرقم الذي يليه سواء كان 1 أو 2 لاعتماد الكود على هذا النص في عملية التجميع

الكود يوضع في موديول

Sub SumAll()
        Dim Cell As Range
        Dim X As Double
        Dim LastColumn As Long
        LastColumn = Cells(52, Columns.Count).End(xlToLeft).Column + 1
        Application.ScreenUpdating = False
            Range("D6:D8").ClearContents
            For Each Cell In Range(Cells(52, 11), Cells(52, LastColumn))
                    If Cell.Value = "مجموع 1" Then X = Cell.Offset(, 1): Range("D6") = Range("D6").Value + X
                    If Cell.Value = "مجموع 2" Then X = Cell.Offset(, 1): Range("D8") = Range("D8").Value + X
            Next Cell
        Application.ScreenUpdating = True
End Sub

ثم يوضع الكود التالي في حدث ورقة العمل

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    SumAll
End Sub

تقبل تحياتي

Sum Totals For All Tables.rar