Genaugenommen muss der Code dafür nochmal umgeschrieben werden. Denn ohne Sortierung kommt sonst der Bug wieder zum Vorschein, dass mehrere gleichartige Datensätze angelegt werden. Hier der neue Code damit ist das Problem aus der Welt.

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
         
      '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 If
End Sub

Gruß Mr. K.