Option
Explicit
Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
a
As
Integer
If
Selection.Count > 1
Then
Application.EnableEvents =
False
Application.Undo
Application.EnableEvents =
True
MsgBox
"In diesen Bereich dürefen sie nur eine Zelle wählen!"
Exit
Sub
End
If
If
Intersect(Target, Range(
"A2:A20"
))
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"
Application.EnableEvents =
False
Target =
""
Application.EnableEvents =
True
Exit
Sub
End
If
Next
a
Application.EnableEvents =
False
If
Target.Text >
""
Then
Sheets(
"Vorlage"
).Copy Before:=Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Target
Target.Offset(0, 1) = ActiveSheet.Name
ElseIf
Target.Text =
""
Then
On
Error
Resume
Next
Application.DisplayAlerts =
False
Sheets(Target.Offset(0, 1).Text).Delete
Target.Offset(0, 1) =
""
Application.DisplayAlerts =
True
End
If
Application.EnableEvents =
True
End
Sub
Sub
jKLÖDJWÖ()
Application.EnableEvents =
True
End
Sub