AuditTrail / in erste leere Zelle schrei

Hallo zusammen,
ich möchte eine Art AuditTrail in eine Datei einbauen. Der reine AuditTrail, siehe unten, funktioniert auch.
Ich scheitere aktuell allerdings daran, eine Art Verlauf einzubauen. Das heißt, wenn die jeweiligen Zellen H und I voll sind, sollen die Daten jeweils zwei Zellen weiter rechts eingefügt werden.
Ich habe schon einiges versucht, mir fehlt allerdings die erfahrung.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rC As Range
If Intersect(Target, Range("Y:Y")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect Password:="Test"
Application.EnableEvents = False
For Each rC In Target.Cells
Sheets("Log").Range("H" & rC.Row) = Now()            ' Zeit
Sheets("Log").Range("i" & rC.Row) = Environ("username") ' Benutzer
Next rC
ActiveSheet.Protect Password:="Test"
Application.EnableEvents = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim rC As Range, LC As Integer If Intersect(Target, Range("Y:Y")) Is Nothing Then Exit Sub '? muss hier nicht das LOG Blatt entsperrt werden? ActiveSheet.Unprotect Password:="Test" Application.EnableEvents = False For Each rC In Target.Cells With Sheets("Log") LC = .Cells(rC.Row, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile If LC

Private Sub Worksheet_Change(ByVal Target As Range) Dim rC As Range, LC As Integer If Intersect(Target, Range("Y:Y")) Is Nothing Then Exit Sub ActiveWorkbook.Sheets("Log").Unprotect Password:="Test" Application.EnableEvents = False For Each rC In Target.Cells With Sheets("Log") LC = .Cells(rC.Row, .Columns.Count).End(xlToLeft).Column 'letzte Spalte einer Zeile If LC

Private Sub Worksheet_Change(ByVal Target As Range) Dim rC As Range, AltWert If Intersect(Target, Range("Y:Y")) Is Nothing Then Exit Sub Application.EnableEvents = False For Each rC In Target.Cells With Sheets("Log") Application.Undo AltWert = Target.Value Application.Undo 'leere Zellen einfügen .Cells(rC.Row, 8).Resize(1, 4).Insert xlToRight .Cells(rC.Row, 8) = AltWert .Cells(rC.Row, 9) = Target.Value .Cells(rC.Row, 10) = Now() ' Zeit .Cells(rC.Row, 11) = Environ("username") ' Benutzer End With Next rC Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim rC As Range, LC As Integer, AltWert On Error Resume Next If Intersect(Target, Range("Y1:Y22001")) Is Nothing Then Exit Sub ActiveWorkbook.Sheets("StatusLog_FY20_21").Unprotect Password:="Status" Application.Calculation = xlCalculationManual Application.EnableEvents = False For Each rC In Target.Cells With Sheets("StatusLog_FY20_21") Application.Undo AltWert = Target.Value Application.Undo LC = .Cells(rC.Row, .Columns.Count).End(xlToLeft).Column 'letzte Spalte _ einer Zeile If LC

Beliebteste Forumthreads (12 Monate)

AuditTrail / in erste leere Zelle schrei

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

AuditTrail / in erste leere Zelle schrei

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread