Hallo zusammen,

ich habe ein Makro, dass von einem Vorlagenblatt eine Kopie erstellt. Dazu fragt es den Namen des neu zu erstellenden Blatts über eine InputBox ab, und fügt es an vorletzter Stelle in der Arbeitsmappe ein (und gibt eine Fehlermeldung, falls der Name schon existiert). Jetzt möchte ich auf dem neu erstellten Arbeitsblatt eine bestimmte Range von Zellen sperren, damit in diesen keine Eintragungen vorgenommen werden können. Mit meiner Lösung habe ich aber das Problem, dass ich gar keine Zellen anklicken kann oder Eintragungen vornehmen kann, weil "die Zellen auf einem schreibgeschützten Blatt" sind. Mir ist das unverständlich, weil ich ja nur eine bestimmte Range gesperrt habe.

Hier der Code:

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("lastChange").Copy After:=Sheets(Sheets.Count)
   'Worksheets(Sheets.Count).Name = newName & "LastChange"
   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"
   'ThisWorkbook.Protect Password:="abc", structure:=True
   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

Kann mir jemand sagen wie ich das Problem lösen kann?