Sub bbb()
Dim i&, j&, p As Range, q As Range, v(), w(), x#
With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
Set p = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1).Cells
w = p.Value
j = 1
Do While j <= UBound(w)
Set q = p.Cells(j, 1).Cells
If q.MergeCells = True Then
v = q.Offset(0, -1).Resize(q.MergeArea.Count, 1).Value
x = 0: For i = 1 To UBound(v): x = x + v(i, 1): Next
w(j, 1) = x
j = j + UBound(v)
Else
w(j, 1) = q.Offset(0, -1).Value
j = j + 1
End If
Loop
p.Value = w
With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub