Fehler abfangen von Target.Value

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim ErsteFreieZeile As Long Dim AlterWert As Variant, NeuerWert As Variant Dim rngNeuSel As Range If Sh.Name = "Protokoll" Then Exit Sub If Intersect(Target, Sh.Range("A1:CC1000")) Is Nothing Then Exit Sub Application.EnableEvents = False NeuerWert = Target.Value Set rngNeuSel = Selection Application.Undo AlterWert = Target.Value '

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Luschi,
danke für die Info.
Ich habe es entsprechend angepasst.
Jetzt hat sich ein ganz anderes Problem gezeigt.
Innerhalb dieser Datei gibt es noch ein weiteres Makro, welches identische Datensätze in einer anderen Datei sucht, kopiert und hier wieder einfügt.
Der Code läuft durch bis zu der Schleife, welche die Werte einfügt. (getestet in dem ich einige "msgbox'es" eingefügt habe)
Schleife:
For z = 50 To lastcell1
For y = 13 To lastcell2
If Worksheets(sheet1).Cells(z, 63) = Worksheets("PT").Cells(y, 3) Then
Worksheets(sheet1).Cells(z, 57) = Worksheets("PT").Cells(y, 13)
Worksheets(sheet1).Cells(z, 58) = Worksheets("PT").Cells(y, 10)
Worksheets(sheet1).Cells(z, 59) = Worksheets("PT").Cells(y, 9)
Worksheets(sheet1).Cells(z, 60) = Worksheets("PT").Cells(y, 14)
Worksheets(sheet1).Cells(z, 61) = Worksheets("PT").Cells(y, 15)
End If
Die Schleife als solches funktioniert problemlos und der Rest auch.
erst seit dem ich die Protokollierung in diese Datei gebastelt habe, bleibt der Code hier stehen:


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
Dim ErsteFreieZeile As Long
Dim AlterWert As Variant, NeuerWert As Variant
Dim rngNeuSel As Range
If Sh.Name = "Protokoll" Then Exit Sub
If Sh.Name = "PT" Then Exit Sub
If Intersect(Target, Sh.Range("A1:DD1000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
NeuerWert = Target.Value
Set rngNeuSel = Selection
Application.Undo


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
AlterWert = Target
End Sub

Gibts eine Idee wie man das abfangen könnte?
Oder anders gefragt, warum kommt der Fehler gerade hier?
Vielen Dank vorab.
Gruß Stefan

Dim AlterWert Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) AlterWert = Target.Value End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If Sh.Name = "Protokoll" Then Exit Sub If Sh.Name = "PT" Then Exit Sub Application.EnableEvents = False If Not Intersect(Target, Sh.Range("A1:DD1000")) Is Nothing Then If Target.Cells.CountLarge > 1 Then Application.Undo 'Das Rückspielen von AlterWert funktioniert nur bei eine Zelle, nicht bei mehreren MsgBox "Es darf nur eine Zelle geändert werden." Else Protokolliere Sh.Name, Target.Address(0, 0), Target.Value, AlterWert, Target.EntireRow.Cells([DplKltxt].Column) End If End If Application.EnableEvents = True End Sub Private Sub Protokolliere(Blatt, Zelle, NeuerWert, AlterWert, Optional Sonstiges = "") Dim AppEE As Boolean AppEE = Application.EnableEvents Application.EnableEvents = False With Sheets("Protokoll").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow .Cells(1) = Blatt .Cells(2) = Zelle .Cells(3) = NeuerWert .Cells(4) = AlterWert .Cells(5) = Date .Cells(6) = Time .Cells(7) = Environ("username") .Cells(8) = Sonstiges End With Application.EnableEvents = AppEE End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread