Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim suche
Dim ergebnis As Object
Dim ende
If Sh.Index < 4 Then
If Target.Row > 8 Then
suche = Worksheets(Sh.Index).Cells(Target.Row, 1)
Set ergebnis = Worksheets(4).Columns(1).Find(suche, LookIn:=xlValues)
If ergebnis Is Nothing Then
ende = Worksheets(4).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(4).Cells(ende + 1, 1) = suche
Worksheets(4).Cells(ende + 2, 1) = suche
Worksheets(4).Cells(ende + 3, 1) = suche
Worksheets(4).Cells(ende + 4, 1) = suche
Worksheets(Sh.Index).Rows(Target.Row).Copy Destination:=Worksheets(4).Rows(ende + 1 + Sh.Index)
Else
Worksheets(Sh.Index).Rows(Target.Row).Copy Destination:=Worksheets(4).Rows(ergebnis.Row + Sh.Index)
End If
End If
End If
End Sub