Private Sub CommandButton1_Click()
If ThisWorkbook.ActiveSheet.Name <> "NeuesBlatt" Then
umsonst = MsgBox("Bitte nur die Vorlage kopieren", vbOKOnly + vbCritical, "Fehler")
Exit Sub
End If
newName = Application.InputBox(prompt:="NeueNummer", Type:=2)
If newName <> False Then
For Each meinObjekt In Worksheets
If meinObjekt.Name = newName Then
umsonst = MsgBox("Diese Nummmer gibt es schon", vbOKOnly + vbCritical, "Fehler")
Exit Sub
End If
Next
ThisWorkbook.Unprotect Password:="abc"
blattZahl = ThisWorkbook.Worksheets.Count - 1
ThisWorkbook.Worksheets("NeuesBlatt").Copy After:=ThisWorkbook.Worksheets(blattZahl)
blattZahl = blattZahl + 1
Worksheets(blattZahl).Name = newName
Worksheets(newName).Activate
ThisWorkbook.Worksheets(newName).Cells(4, 30) = newName
ThisWorkbook.Worksheets(newName).Cells(4, 30).Interior.ColorIndex = 0
ThisWorkbook.Worksheets(newName).Cells(5, 30) = Format(Now(), "dd.mm.yyyy")
ThisWorkbook.Worksheets(newName).Cells(5, 30).Interior.ColorIndex = 0
ActiveSheet.Shapes("CommandButton1").Delete
ActiveSheet.Range("A111:G114,A116:G123,I111:P129,R111:AC133").Locked = True
ActiveSheet.Protect "abc"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Sheets("lastChange").Cells(Target.Row, Target.Column) = Now()
If (Hour(Now()) >= 6 And Hour(Now()) < 14) Then
Target.Interior.Color = RGB(6, 206, 249)
ElseIf (Hour(Now()) >= 14 And Hour(Now()) < 22) Then
Target.Interior.Color = RGB(150, 200, 0)
Else
Target.Interior.Color = RGB(200, 150, 0)
End If
ThisWorkbook.Protect Password:="abc", structure:=True
End Sub