Useraktionen logen

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim lRow As Long With Worksheets("ProtDet") lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRow, 1).Value = Target.Address(False, False) .Cells(lRow, 2).Value = Now .Cells(lRow, 3).Value = Application.UserName .Cells(lRow, 4).Value = Target.Value End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim lRow As Long Application.EnableEvents = False With Worksheets("ProtDet") lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRow, 1).Value = Target.Address(False, False) .Cells(lRow, 2).Value = Now .Cells(lRow, 3).Value = Application.UserName .Cells(lRow, 4).Value = Target.Value End With Application.EnableEvents = True End Sub

Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim lRow As Long Dim arMonat() Dim Zellen As Range 'Tabellen die überwacht werden sollen arMonat = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember") If IsNumeric(Application.Match(Sh.Name, arMonat, 0)) Then Application.EnableEvents = False For Each Zellen In Target With Worksheets("ProtDet") lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRow, 1).Value = Sh.Name & "!" & Target.Address(False, False) .Cells(lRow, 2).Value = Now .Cells(lRow, 3).Value = Application.UserName .Cells(lRow, 4).Value = Target.Value End With Next Zellen Application.EnableEvents = True End If End Sub

Hallo,
allerdings würde ich den überwachten Bereich auf das nötige einschränken,
sonst kann es passieren wenn einer den gesamten Tabellenbereich überschreibt
z. Bsp. durch kopieren, dass Dein Makro Purzelbäume schlägt.
z. Bsp. so
kommt als Code in DieseArbeitsmappe

Option Explicit 
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
Dim lRow As Long 
Dim arMonat() 
Dim Zellen As Range 
 
'Tabellen die überwacht werden sollen 
arMonat = Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", "September", "Oktober", "November", "Dezember") 
 
If IsNumeric(Application.Match(Sh.Name, arMonat, 0)) Then 
 Set Zellen = Intersect(Sh.Range("A1:Z500"), Target) '<--------- Überwchten Bereich einschränken 
    If Not Zellen Is Nothing Then 
      Application.EnableEvents = False 
           For Each Zellen In Zellen 
             With Worksheets("ProtDet") 
                 lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 
                .Cells(lRow, 1).Value = Sh.Name & "!" & Target.Address(False, False) 
                .Cells(lRow, 2).Value = Now 
                .Cells(lRow, 3).Value = Application.UserName 
                .Cells(lRow, 4).Value = Target.Value 
             End With 
           Next Zellen 
       Application.EnableEvents = True 
    End If 
End If 
End Sub

Oder besser wäre die Zellen die nicht bearbeitet werden zu schützen.
Gruß Tino

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread