Hallo Christoph,
diverse Ansätze: Sub Zellenschützen() ' Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim InMldg AsInteger ' Variante 1 Zellbereiche auswählen und schützen If Target.Row <= 5 And Target.Column <= 17 Then MsgBox "In diesem Bereich dürfen keine Änderungen stattfinden", 16, "Warnung" Application.EnableEvents = False Cells(6, Target.Column).Select Application.EnableEvents = True EndIf ' Variante 2 Zellen mit Formeln schützen If Target.HasFormula Then MsgBox "Diese Formel ist absichtlich geschützt", 16, "Warnung" Application.EnableEvents = False Cells(6, Target.Column).Select Application.EnableEvents = True EndIf ' Variante 3 Zellen ohne Farbe schützen If Application.ActiveCell.Interior.ColorIndex = xlNone Then MsgBox "Eingabe ist nur in farblicher zelle möglich", 16, "Warnung" Application.EnableEvents = False Cells(6, Target.Column).Select Application.EnableEvents = True EndIf ' Variante 4 Zelle ohne Farbe schützen, Aufforderung ändern ja/nein If Application.ActiveCell.Interior.ColorIndex = 1 Then InMldg = MsgBox("Wollen Sie die Formel ändern", vbYesNo + vbQuestion, "Formelabfrage ?", "", 0) If InMldg = 6 ThenExitSub ' kann auch weggelassen werden Target.Offset(0, 1).Select EndIf EndSub
' Bestimmung für welche Tabellenblätter der Schutz gelten soll PrivateSub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) ''Die Blätter, die ausgenommen werden sollen----------- 'If Sh.Name <> "Tabelle1" And Sh.Name <> "Tabelle2" Then ''----------------------------------------------------- If Target.HasFormula Then MsgBox "Diese Formel ist absichtlich geschützt", 16, "Warnung" OnErrorGoTo errhandler Application.EnableEvents = False ' kann auch weggelassen werden ' Cells(6, Target.Column).Select
EndIf
'End If errhandler: Application.EnableEvents = True EndSub