Option
Explicit
Private
Sub
CommandButton1_Click()
Dim
wks
As
Worksheet
Set
wks = ThisWorkbook.Worksheets(
"Tabelle1"
)
Dim
intZaehler
As
Integer
intZaehler = 1
wks.Range(
"A14"
).
Select
wiederholen:
If
ActiveCell.Value <>
""
Then
ActiveCell.Offset(2, 0).
Select
intZaehler = intZaehler + 1
GoTo
wiederholen
End
If
wks.Range(ActiveCell, ActiveCell.Offset(0, 17)).
Select
With
Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText =
False
.Orientation = 0
.AddIndent =
False
.IndentLevel = 0
.ShrinkToFit =
False
.ReadingOrder = xlContext
.MergeCells =
False
End
With
Selection.Merge
ActiveCell.FormulaR1C1 = intZaehler
ActiveCell.Interior.Color = RGB(200, 200, 200)
Set
wks =
Nothing
End
Sub