بعد اذن أخي بن علية
هذا الماكرو يقوم بالعمل
Option Explicit
Sub salim_sum()
If ActiveSheet.Name <> "ورقة1" Then Exit Sub
Dim lar%: lar = Cells(Rows.Count, 1).End(3).Row
Dim i%, k%: k = 2
Dim arr()
ReDim Preserve arr(1 To 1): arr(1) = 2
For i = 1 To lar + 1
If Cells(i, 1) = vbNullString Then
ReDim Preserve arr(1 To k): arr(k) = Cells(i, 1).Row
k = k + 1
Dim x, y
End If
Next
For i = LBound(arr) To UBound(arr) - 1
If i = 1 Then
x = arr(i + 1) - 1: y = arr(i)
Else
x = arr(i + 1) - 1: y = arr(i) + 1
End If
Cells(arr(i + 1), 3).Formula = "=SUM(C" & y & ":C" & x & ")"
Cells(arr(i + 1), 3).AutoFill Cells(arr(i + 1), 3).Resize(1, 10)
Cells(arr(i + 1), 3).Resize(1, 10).Value = _
Cells(arr(i + 1), 3).Resize(1, 10).Value
Next
End Sub
الملف مرفق
salim_summation .xlsm