VBA - Code auf Bereich erweitern

[SteBen]

Hallo zusammen,

ich suche nach einer Möglichkeit, folgenden Code so umzuschreiben, dass er automatisch auf die Zeilen 4 - 1000 anwendbar ist.

Hat jemand eine Idee?

Vielen Dank vorab 

Code:

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range

' Kollege 1
Set Bereich = Range("L4:EC4")

'FY

If ActiveSheet.Range("ED4").Value <> "NOT OK" Then

Else

MsgBox "Eintragung nicht möglich! Max. Anzahl von Jokertagen  für dieses Jahr erreicht!", vbOKOnly, "Error"

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

End If


'Q1

If ActiveSheet.Range("EE4").Value <> "NOT OK" Then

Else

MsgBox "Eintragung nicht möglich! Max. Anzahl von Jokertagen  für dieses Quartal erreicht!", vbOKOnly, "Error"

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

End If

'Q2

If ActiveSheet.Range("EF4").Value <> "NOT OK" Then

Else

MsgBox "Eintragung nicht möglich! Max. Anzahl von Jokertagen  für dieses Quartal erreicht!", vbOKOnly, "Error"

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

End If

'Q3

If ActiveSheet.Range("EG4").Value <> "NOT OK" Then

Else

MsgBox "Eintragung nicht möglich! Max. Anzahl von Jokertagen  für dieses Quartal erreicht!", vbOKOnly, "Error"

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

End If

'Q4

If ActiveSheet.Range("EH4").Value <> "NOT OK" Then

Else

MsgBox "Eintragung nicht möglich! Max. Anzahl von Jokertagen  für dieses Quartal erreicht!", vbOKOnly, "Error"

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

End If
End Sub

[Fennek]

Hallo,

ich habe den Code nicht gelesen, aber einen Vorschlag gibt es trotzdem:

Code:

Set Bereich = Range("L4:EC1000")

if not intersect(Target, Bereich) is nothing then

mfg