Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim suche
Dim ende As Long
Dim ende2 As Long
Dim endesh As Long
Dim anzahl As Long
Dim i As Long
Dim zeile As Integer
Dim zeilesh As Integer
Dim gefunden As Boolean
Dim adresse As String
Dim blatt()
Dim temp
Dim anzsuch
blatt = Array("", "Kursaal", "Galerie", "Konferenzraum")
If Sh.Index < 4 Then
If Target.Row > 8 Then
suche = Worksheets(Sh.Index).Cells(Target.Row, 1)
anzsuch = 0
anzsuch = Application.WorksheetFunction.CountIf(Worksheets(4).Columns(1), suche)
If suche = "" Then Exit Sub
If anzsuch = 0 Then
ende = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(4).Cells(ende + 1, 1) = suche
Worksheets(4).Cells.Rows(ende + 1).Borders(xlInsideVertical).LineStyle = xlNone
Worksheets(4).Cells.Rows(ende + 1).Borders(xlEdgeLeft).LineStyle = xlNone
Worksheets(4).Cells.Rows(ende + 1).Borders(xlEdgeRight).LineStyle = xlNone
Worksheets(Sh.Index).Rows(Target.Row).Copy Destination:=Worksheets(4).Rows(ende + 1 + Sh.Index)
Worksheets(4).Cells(ende + 2, 1) = suche
Worksheets(4).Cells(ende + 2, 4) = blatt(1)
Worksheets(4).Cells(ende + 3, 1) = suche
Worksheets(4).Cells(ende + 3, 4) = blatt(2)
Worksheets(4).Cells(ende + 4, 1) = suche
Worksheets(4).Cells(ende + 4, 4) = blatt(3)
Else
suche = CLng(CDate(suche))
zeile = Application.WorksheetFunction.Match(CLng(suche), Worksheets(4).Columns(1), 0)
zeile = zeile + 1
gefunden = False
While gefunden = False
If Worksheets(4).Cells(zeile, 4) = blatt(Trim(Sh.Index)) Then
gefunden = True
anzahl = Application.WorksheetFunction.CountIf(Worksheets(Sh.Index).Range(Worksheets(Sh.Index).Cells(9, 1), Cells(Rows.Count, 1)), suche)
temp = Application.WorksheetFunction.Match(CLng(suche), Worksheets(Sh.Index).Columns(1), 0)
zeilesh = temp
For i = 1 To anzahl
If Worksheets(4).Cells(zeile, 4) = blatt(Trim(Sh.Index)) Then
Worksheets(Sh.Index).Rows(zeilesh).Copy Destination:=Worksheets(4).Rows(zeile)
Worksheets(4).Cells(zeile, 4) = blatt(Trim(Sh.Index))
Worksheets(4).Cells(zeile, 1) = CDate(suche)
Else
Worksheets(4).Rows(zeile).EntireRow.Insert Shift:=xlDown
Worksheets(Sh.Index).Rows(zeilesh).Copy Destination:=Worksheets(4).Rows(zeile)
Worksheets(4).Cells(zeile, 4) = blatt(Trim(Sh.Index))
Worksheets(4).Cells(zeile, 1) = CDate(suche)
End If
If i < anzahl Then
ende2 = Worksheets(Sh.Index).Cells(Rows.Count, 1).End(xlUp).Row
temp = Application.WorksheetFunction.Match(CLng(suche), Worksheets(Sh.Index).Columns(1).Rows(zeilesh & ":" & ende2), 0)
zeilesh = temp + zeilesh
End If
zeile = zeile + 1
Next i
Else
zeile = zeile + 1
End If
If zeile > Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row + 2 Then gefunden = True
Wend
End If
End If
End If
Worksheets(4).Cells.Interior.ColorIndex = xlNone
End Sub