Clever-Excel-Forum

Normale Version: VBA - Code auf Bereich erweitern
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
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
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