Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ziel As Worksheet, lastrow As Long, c1 As Range, c2 As Range, c3 As Range, found As Boolean
Set ziel = Sheets("Zusammenfassung")
If Sh.Name <> ziel.Name Then
If Not Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
lastrow = ziel.Cells(ziel.Rows.Count, 1).End(xlUp).Row
Set c1 = ziel.Range(ziel.Cells(1, 1), ziel.Cells(lastrow, 6)).Find(Sh.Name)
If Not c1 Is Nothing Then
Set c2 = ziel.Range(ziel.Cells(c1.Row, 1), ziel.Cells(lastrow, 6)).Find(Cells(Target.Row, 1))
If Not c2 Is Nothing Then
Set c3 = ziel.Range(ziel.Cells(c2.Row, 2), ziel.Cells(lastrow, 6)).Find(Cells(1, Target.Column - _
IIf(Cells(2, Target.Column) = "ID", 1, IIf(Cells(2, Target.Column) = "EQUI", 2, 0))))
If Not c3 Is Nothing Then
r = c3.Row
If ziel.Cells(r, 1) = c1 And ziel.Cells(r, 2) = c2 Then found = True
End If
End If
End If
If Not found Then
r = lastrow + 1
ziel.Cells(r, 1) = Sh.Name
ziel.Cells(r, 2) = Cells(Target.Row, 1)
ziel.Cells(r, 3) = Cells(1, Target.Column - _
IIf(Cells(2, Target.Column) = "ID", 1, IIf(Cells(2, Target.Column) = "EQUI", 2, 0)))
End If
ziel.Cells(r, 4 + _
IIf(Cells(2, Target.Column) = "ID", 1, IIf(Cells(2, Target.Column) = "EQUI", 2, 0))) = Target
If Not found Then
ziel.Range(ziel.Cells(1, 1), ziel.Cells(r, 6)).Sort _
Key1:=ziel.Range("A1"), Order1:=xlAscending, Key2:=ziel.Range("C1"), _
Order2:=xlAscending, Key3:=ziel.Range("B1"), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End If
End Sub