Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Gebäude As String, Raum As String, PC As String
Dim ziel As Worksheet, lastrow As Long, g As Range, found As Boolean
Set ziel = Sheets("Zusammenfassung")
If Sh.Name <> ziel.Name Then
If Not Intersect(Target, Range("B:S")) Is Nothing Then
lastrow = ziel.Cells(ziel.Rows.Count, 1).End(xlUp).Row
Gebäude = Sh.Name
Raum = Cells(Target.Row, 1)
PC = Cells(1, Target.Column - IIf(Cells(2, Target.Column) = "ID", 1, IIf(Cells(2, Target.Column) = "EQUI", 2, 0)))
Set g = ziel.Range(ziel.Cells(1, 1), ziel.Cells(lastrow, 6)).Find(Gebäude)
If Not g Is Nothing Then
Start = g.Address
Do
Set g = ziel.Range(ziel.Cells(1, 1), ziel.Cells(lastrow, 1)).FindNext(g)
If g.Offset(0, 1) = Raum And g.Offset(0, 2) = PC Then
r = g.Row
found = True
Exit Do
End If
Loop Until g.Address = Start
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
End If
End If
End Sub