Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then 'wenn also was in Spalte 6 (F) passiert
If Target.Row > 1 And Target.Row <= 65536 Then 'und zwar zwischen Zeile 2 und 65536
'dann wird die erste Zelle der gerade in Tabelle 1 beschriebenen Zeile
'in die erste Zelle der ersten freien Zeile von Tabelle 2 kopiert.
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlDown).Select
ActiveCell.Select
Selection.Copy
Sheets(Tabelle2).Select
Selection.End(xlToLeft).Select
Selection.End(xlUp).Select
Selection.End(xlUp).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Sheets(Tabelle1).Select
ActiveCell.Offset(0, 1).Select
'das wird dann mit jeder folgenden vollen Zelle der soeben beschriebenen Zeile gemacht
Do While ActiveCell.Value <>
Selection.Copy
Sheets(Tabelle2).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
Sheets(Tabelle1).Select
ActiveCell.Offset(0, 1).Select
Loop
Application.CutCopyMode = False
ActiveCell.Offset(0, -1).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
'am Schluß wird dann die erste Zelle in der ersten freien Zeile in Tabelle 1 markiert
'von hier aus kann dann der nächste Datensatz beschrieben werden.
ActiveCell.Offset(0, 1).Select
End If
End If
End Sub