VBA Änderungen Verfolgen Protokoll "Alter Wert"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim ErsteFreieZeile As Long If Target.Count > 1 Then Exit Sub If Sh.Name = "Protokoll" Then Exit Sub If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub With Sheets("Protokoll") ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(ErsteFreieZeile, 1) = Sh.Name .Cells(ErsteFreieZeile, 2) = Target.Address(0, 0) .Cells(ErsteFreieZeile, 3) = Target.Value .Cells(ErsteFreieZeile, 4) = Date .Cells(ErsteFreieZeile, 5) = Time .Cells(ErsteFreieZeile, 6) = Environ("username") End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Public AlterWert As Variant Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim ErsteFreieZeile As Long If Target.Count > 1 Then Exit Sub If Sh.Name = "Protokoll" Then Exit Sub If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub With Sheets("Protokoll") ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(ErsteFreieZeile, 1) = Sh.Name .Cells(ErsteFreieZeile, 2) = Target.Address(0, 0) .Cells(ErsteFreieZeile, 3) = Target.Value .Cells(ErsteFreieZeile, 4) = "Alter Wert:" & " " & AlterWert .Cells(ErsteFreieZeile, 5) = Date .Cells(ErsteFreieZeile, 6) = Time .Cells(ErsteFreieZeile, 7) = Environ("username") End With End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Sh.Name = "Protokoll" Then Exit Sub If Not Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then AlterWert = Target.Value End If End Sub

Danke euch, hat mir sehr geholfen. Das Problem bei der integrierten Möglichkeit ist, falls 100 Änderungen gemacht werden dann hab ich diese irgendwie nicht Protokolliert sondern muss diese einzeln durchklicken und bestätigen. Deswegen denke ich das diese Möglichkeit die ich benutze die bessere ist (Falls nicht, bin ich offen für Vorschläge). Ich habe den Code noch ein bisschen angepasst, sodass nur ich die Änderungen in einem Protokoll sehen kann.

Public AlterWert As Variant
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ErsteFreieZeile As Long
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Protokoll" Then Exit Sub
If Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then Exit Sub
With Sheets("Protokoll")
ErsteFreieZeile = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(ErsteFreieZeile, 1) = Sh.Name
.Cells(ErsteFreieZeile, 2) = Target.Address(0, 0)
.Cells(ErsteFreieZeile, 3) = AlterWert
.Cells(ErsteFreieZeile, 4) = Target.Value
.Cells(ErsteFreieZeile, 5) = Date
.Cells(ErsteFreieZeile, 6) = Time
.Cells(ErsteFreieZeile, 7) = Environ("username")
End With
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Sh.Name = "Protokoll" Then Exit Sub
If Not Intersect(Target, Sh.Range("A9:Q550")) Is Nothing Then
AlterWert = Target.Value
End If
End Sub
Private Sub Workbook_Open()
If Environ("username") = "NAME" Then 'anpassen!
Worksheets("Protokoll").Visible = xlSheetVisible
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("Protokoll").Visible = xlSheetVeryHidden
End Sub

Beliebteste Forumthreads (12 Monate)

VBA Änderungen Verfolgen Protokoll "Alter Wert"

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Änderungen Verfolgen Protokoll "Alter Wert"

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread