Prüfen ob Blattschutz, dann in Zelle schreiben.

[CaptainNemo]

Hi,

warum habe ich so ein Problem ("nicht genügend Stapelspeicher" oder Excel schmiert gleich ganz ab), seit ich den If-Block zwischen VON HIER bis BIS HIER eingefügt habe?

excelhafte Grüße
Uweverursacht

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rngZelle As Range
   Dim r As Long                   ' Target.Row
   r = Target.Row
   If r >= 5 Then
       If Not Intersect(Target, Columns(2)) Is Nothing Then
           If Target.Cells(1) <> "" Then
               Application.EnableEvents = False
               For Each rngZelle In Target
                   If Not Intersect(rngZelle, Columns(2)) Is Nothing Then
                       If rngZelle.Offset(0, -1) = "" Then rngZelle.Offset(0, -1) = Now
                   End If
               Next rngZelle
               Application.EnableEvents = True
           End If
       End If
   End If
----->VON HIER    
   If ActiveSheet.ProtectContents = True Then
       Cells(1, 12).Value = "Kein Blattschutz gesetzt"
       Else
       Cells(1, 12).Value = ""
   End If
----->BIS HIER    
   If ToggleButton1.Caption = "Eingabe" Then
   If Not Intersect(Range("A5:A1048576"), Target) Is Nothing Then Target.Offset(0, 1).Select
   If Not Intersect(Range("B5:B1048576"), Target) Is Nothing Then Target.Offset(0, 1).Select
   If Not Intersect(Range("C5:C1048576"), Target) Is Nothing Then Target.Offset(1, -1).Select
   End If
   
End Sub

[Steffl]

Hallo,

schalt mal die Ereignisse aus

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rngZelle As Range
   Dim r As Long                   ' Target.Row
   r = Target.Row
   If r >= 5 Then
       If Not Intersect(Target, Columns(2)) Is Nothing Then
           If Target.Cells(1) <> "" Then
               Application.EnableEvents = False
               For Each rngZelle In Target
                   If Not Intersect(rngZelle, Columns(2)) Is Nothing Then
                       If rngZelle.Offset(0, -1) = "" Then rngZelle.Offset(0, -1) = Now
                   End If
               Next rngZelle
               Application.EnableEvents = True
           End If
       End If
   End If
----->VON HIER
   Application.EnableEvents = False
   If ActiveSheet.ProtectContents = True Then
       Cells(1, 12).Value = "Kein Blattschutz gesetzt"
       Else
       Cells(1, 12).Value = ""
   End If
   Application.EnableEvents = True
----->BIS HIER
   If ToggleButton1.Caption = "Eingabe" Then
   If Not Intersect(Range("A5:A1048576"), Target) Is Nothing Then Target.Offset(0, 1).Select
   If Not Intersect(Range("B5:B1048576"), Target) Is Nothing Then Target.Offset(0, 1).Select
   If Not Intersect(Range("C5:C1048576"), Target) Is Nothing Then Target.Offset(1, -1).Select
   End If
  
End Sub

[CaptainNemo]

Ich dachte, ich hätte das probiert. Irgendwas war wohl verkehrt. Danke!