https://www.herber.de/bbs/user/156420.xls
Sub summeunterblock()
Dim i&, sBereich As String
With ActiveSheet
For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If .Cells(i, "A").Value = "Bestellnummer" Then
sBereich = .Range(.Cells(i + 1, "A"), .Cells(i, "A").End(xlDown)).Address
Debug.Print sBereich
With .Range(sBereich).End(xlDown).Offset(1, 5)
.Formula = "=Sum(" & Range(sBereich).Offset(, 5).Address & ")"
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThick
End With
End With
End If
Next
End With
End Sub