ich habe folgendes Makro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bolhj As Boolean
Dim dtDatum As Date
Dim interv As Double, lastcol&, i&
Dim res
Dim strHJ As String
If Not Intersect(Range("C2:C1000"), Target) Is Nothing Then
interv = Target.Value
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Application.EnableEvents = False
If interv > 0 Then
dtDatum = Target.Offset(0, -1).Value
If Month(dtDatum) <= 6 Then
strHJ = "1.Halbjahr " & Year(dtDatum)
Else
strHJ = "2.Halbjahr " & Year(dtDatum)
End If
res = Application.Match(strHJ, Rows("1:1"), 0)
If IsNumeric(res) Then
Cells(Target.Row, 4).Resize(1, lastcol - 3).ClearContents
For i = res To lastcol Step interv * 2
Cells(Target.Row, i) = 1
Next
End If
Else
Cells(Target.Row, 4).Resize(1, lastcol - 3).ClearContents
End If
Application.EnableEvents = True
End If
End Sub