Option
Explicit
Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
a
As
Integer
With
Application
If
Intersect(Target, Range(
"A9:A200"
))
Is
Nothing
Then
Exit
Sub
If
Selection.Count > 1
Then
.EnableEvents =
False
.Undo
.EnableEvents =
True
MsgBox
"In diesen Bereich dürfen sie nur eine Zelle wählen!"
Exit
Sub
End
If
If
Intersect(Target, Range(
"A9:A200"
))
Is
Nothing
Then
Exit
Sub
For
a = 1
To
ThisWorkbook.Sheets.Count
If
Sheets(a).Name = Target.Text
Then
MsgBox
"Tabelle mit den Namen: "
& Target &
" ist schon vorhanden"
.EnableEvents =
False
Target =
""
.EnableEvents =
True
Exit
Sub
End
If
Next
a
.EnableEvents =
False
If
Target >
""
And
Target.Offset(0, 1) <> Target
And
_
Target.Offset(0, 1) <>
""
Then
Sheets(Target.Offset(0, 1).Text).Name = Target.Text
Target.Offset(0, 1) = Target
ElseIf
Target.Text >
""
Then
Sheets(
"KennzahlenVorlage"
).Copy Before:=Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Target
Target.Offset(0, 1) = ActiveSheet.Name
ElseIf
Target.Text =
""
Then
On
Error
Resume
Next
.DisplayAlerts =
False
Sheets(Target.Offset(0, 1).Text).Delete
Target.Offset(0, 1) =
""
.DisplayAlerts =
True
End
If
.EnableEvents =
True
End
With
End
Sub
Sub
Projektdatenblatthinzufuegen()
Application.EnableEvents =
True
End
Sub