Hallo zusammen,
der Code hat zwar an sich das getan was ich wollte, jedoch zeigt mir nun mein anderer Code einen Fehler an, wenn ich auf "Neuer Eintrag" klicke.
Wisst Ihr woran das liegen könnte?
Hier ist der Code der durch drücken des Buttons "Neuer Eintrag" ausgelöst wird.
Option Explicit
Sub NeuerEintrag()
'Blattschutz deaktivieren
Worksheets("Mitarbeiterliste").Unprotect "Rollenliste"
'Neue Zeile einfügen
Rows("7:7").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
Range("M8").Select
Selection.AutoFill Destination:=Range("M7:M8"), Type:=xlFillDefault
Range("M7:M8").Select
Range("K8").Select
Selection.AutoFill Destination:=Range("K7:K8"), Type:=xlFillDefault
Range("K7:K8").Select
Range("I8").Select
Selection.AutoFill Destination:=Range("I7:I8"), Type:=xlFillDefault
Range("O7").Font.ColorIndex = 1
Range("O7").Font.Underline = xlUnderlineStyleNone
'MessageBox
MsgBox "Neue Zeile wurde eingefügt - Bearbeitung in Zeile 7", vbInformation, "Information"
'Blattschutz aktivieren
Worksheets("Mitarbeiterliste").Protect "Rollenliste", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True, AllowInsertingHyperlinks:=True
End Sub
Und euren Code habe ich im Tabellenblatt 1 eingefügt.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Variant
If Not Intersect(Range("I:I"), Target) Is Nothing Then
For Each Zelle In Target
If Cells(Target.Row, "B").Value = "Ja" Then
MsgBox "Hier dein Text: XY"
End If
Next
End If
End Sub
Es kommt dann ein Fehler und das Programm wird abgebrochen!
Wenn ich auf debuggen klicke, wird Zeile 5
"if Cells(Target.Row, "B").Value = "Ja" Then"
gelb markiert.
Könnt ihr mir hier helfen?
Vielen Dank.
Lg Chris :)
|