M01_6455324

Sub Test1()
    Dim xSheet As Worksheet
    Dim xRange As Range
    Dim rowCount As Integer, idx As Integer, idx2 As Integer
    Dim sum As Long

    Set xSheet = ActiveSheet
    Set xRange = xSheet.Range("A1:A2").CurrentRegion
    rowCount = xRange.Rows.Count

    For idx = 2 To rowCount Step 0
        Set xRange = ActiveSheet.Range("B" & idx)

        sum = 0
        For idx2 = idx To idx + xRange.MergeArea.Rows.Count - 1
            If IsNumeric(xSheet.Range("A" & idx2).Value) Then
                sum = sum + xSheet.Range("A" & idx2).Value
            End If
        Next
        xRange.Value = sum
        idx = idx + xRange.MergeArea.Rows.Count
    Next
End Sub