(تمت الاجابة) كود لجمع عمود مهما كان عدد الصفوف التى يحتويها

[oyousef]

الساده الافاضل / اساتذة المنتدى الكرام

السلام عليكم ورحمة الله وبركاته

ارجو المساعده فى كتابة كود يضع كلمة اجمالى تحت اخر تاريخ مدرج مهما كان عدد الخلايا الموجوده فى العمود(A) وفى نفس الصف يتم جمع البيانات الموجوده فى الاعمدة (c,d,e) وذلك فى الخليه التى تقابل كلمة اجمالى

ولكم جزيل الشكر

costs.rar

[يحيى حسين]

السلام عليكم و رحمة الله

جرب هذا الكود اخي

Sub AddTotalE()

Dim LR As Long, i As Integer

LR = Range("b" & Rows.Count).End(xlUp).Row

With Cells(LR + 2, 2)

    .Value = "Total"

    For i = 1 To 3

	    .Offset(, i).Value = WorksheetFunction.Sum(Range(Cells(2, .Offset(, i).Column), Cells(LR, .Offset(, i).Column)))

    Next i

End With

End Sub

[عبدالله المجرب]

وهذا كود أخر

ان شاء الله يفي بالغرض (تعدد الحلول)

Sub Abu_Ahmed()

LR = Range("A" & Rows.Count).End(xlUp).Row + 1

If Range("A" & LR - 1).Value = "الاجمالي" Then MsgBox "تم الجمع سابقاً", vbCritical + vbOKOnly, "تنبيه": Exit Sub

Range("A" & LR).Value = "الاجمالي"

x = Application.Sum(Range("C2:C" & LR))

y = Application.Sum(Range("D2:D" & LR))

z = Application.Sum(Range("E2:E" & LR))

Range("B" & LR).Value = x + y + z

End Sub

[oyousef]

الاخوه الاساتذة الافاضل (الاستاذ يحى , والاستاذ ابو احمد)

شكرا لكم

اوجزتم فانجزتم

الف شكر :fff:

[الـعيدروس]

السلام عليكم

جزيتم خيرا اساتذتي الافاضل

وهكذا لتعدد الحلول

Sub S_ALI()

On Error Resume Next

Dim x As Integer, S, U, M As Integer

T = [a15000].End(xlUp).Row + 1

For x = 2 To T

If Cells(x, 1).Value = "الإجمالــي" Then MsgBox "تم عمل الإجمالي سابقاً": Exit Sub

If IsNumeric(Range("c" & x)) = True Then

S = S + Range("c" & x).Value

U = U + Range("d" & x).Value

M = M + Range("e" & x).Value

End If

Next x

Range("a" & T).Value = "الإجمالــي"

Range("a" & T).Borders.Color = 2

Range("a" & T).Font.Bold = True

Range("a" & T).Offset(0, 1).Borders.Color = 2

Range("a" & T).Offset(0, 2).Value = S: Range("a" & T).Offset(0, 2).Borders.Color = 2

Range("a" & T).Offset(0, 3).Value = U: Range("a" & T).Offset(0, 3).Borders.Color = 2

Range("a" & T).Offset(0, 4).Value = M

Range("a" & T).Offset(0, 4).Borders.Color = 2

End Sub