Veränderungen protokollieren

Private Sub Workbook_Open()
Dim Buffer As String * 100, BuffLen As Long
BuffLen = 100
GetUserName Buffer, BuffLen
Username = Left(Buffer, BuffLen)
Username = Left(Username, InStr(Username, vbNullChar) - 1)
If Trim$(Username) = "" Then Username = Application.Username
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intSpalte As Integer, lngZeile As Long, strBuchstabe1 As String, strBuchstabe2 As  _
String
Dim varArray_neu As Variant, varArray_alt As Variant, intArrayspalte As Integer, strAdresse  _
As String
Dim lngArrayzeile As Long, lngLetzteZeile As Long, varAlt As Variant, varNeu As Variant
If Sh.Name  "Protokoll" Then
If Target.Count > 1 Then varArray_neu = Range(Target.Address) Else varNeu = Target
strAdresse = Selection.Address
With Application
.ScreenUpdating = False
.EnableEvents = False
.Undo
End With
If Target.Count > 1 Then
varArray_alt = Range(Target.Address)
Application.Undo
With Worksheets("Protokoll")
For intSpalte = Target.Column To Target.Column + Target.Columns.Count - 1
intArrayspalte = intArrayspalte + 1
lngArrayzeile = 0
For lngZeile = Target.Row To Target.Row + Target.Rows.Count - 1
lngArrayzeile = lngArrayzeile + 1
If varArray_alt(lngArrayzeile, intArrayspalte)  varArray_neu( _
lngArrayzeile, intArrayspalte) Then
lngLetzteZeile = .Cells(65536, 1).End(xlUp).Row + 1
If lngLetzteZeile = 65536 Then
lngLetzteZeile = 2
.Range("A2:E65536").ClearContents
End If
.Cells(lngLetzteZeile, 1) = Now
.Cells(lngLetzteZeile, 2) = varArray_alt(lngArrayzeile,  _
intArrayspalte)
.Cells(lngLetzteZeile, 3) = varArray_neu(lngArrayzeile,  _
intArrayspalte)
.Cells(lngLetzteZeile, 4) = Cells(lngZeile, intSpalte).Address(0, 0) _
.Cells(lngLetzteZeile, 5) = Sh.Name
.Cells(lngLetzteZeile, 6) = Username
End If
Next
Next
End With
Else
varAlt = Range(Target.Address)
Application.Undo
With Worksheets("Protokoll")
lngLetzteZeile = .Cells(65536, 1).End(xlUp).Row + 1
If lngLetzteZeile = 65536 Then
lngLetzteZeile = 2
.Range("A2:E65536").ClearContents
End If
.Cells(lngLetzteZeile, 1) = Now
.Cells(lngLetzteZeile, 2) = varAlt
.Cells(lngLetzteZeile, 3) = varNeu
.Cells(lngLetzteZeile, 4) = Target.Address(False, False)
.Cells(lngLetzteZeile, 5) = Sh.Name
.Cells(lngLetzteZeile, 6) = Username
End With
End If
Range(strAdresse).Select
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Areas.Count > 1 Then
MsgBox "Auswahl nicht zulässig.", 48, "Hinweis"
Application.EnableEvents = False
Range(Target.Address).Cells(1, 1).Select
Application.EnableEvents = True
End If
End Sub

Dieser Code funktioniert super, protokolliert aber alle Änderungen der Arbeitsmappe. Ich möchte z.B. nur die Tabellen 2 und 4 protokollieren, oder auch nur bestimmte Bereiche wie z.B. A10:C1000 usw. Leider übersteigen diese Anpassungen meine geringen VBA Fähigkeiten. Kann mir daher jemand helfen?
Danke Ralf