Hallo Andrea,
mir ist leider nicht ganz klar, wo Dir die A1-Schreibweise
fehlt?
okay, okay, mein Fehler, ich hatte oben Spalte A30 gelesen, was mich irritierte.
Und, ich habe mir angwöhnt, leider angewöhnen müssen 
, gar nicht lang rumzurätseln sondern sofort nachzufragen.
Zum einen, wie bei dir jetzt, kommen mit anderen Worten von dir gesagt weitere Hinweise was da genau vorliegt, was dann in Kombination mit deinem Anfangsbeitrag alles für Fremde verständlicher macht.
Zum anderen, deshlab eben das Wort „leider“, trennt eine Nachfrage Spreu und Weizen. Sogenannte Eintagsfliegen die mal eben so in Foren eine Frage stellen und dann warum auch immer sich nie mehr darum kümmern fliegen dadurch raus und man „arbeitet“ nicht gleich für die Tonne 
Vielleicht habe ich mich mit Kategorie nicht ganz klar
ausgedrückt.
Ist auch schwierig sich in Fremde hereinzuversetzen wenn man da nur sein Excelproblem im Kopf hat.
Ich kann das auch nicht, aber ich habe mich stark verbessert, indem ich Excelfragen „beantworte“, dadurch stößt du sehr oft auf ähnliche Rückfragen die man hat.
Im Umkehrschluß bedeutet das, stelle ich selbst mal eine Anfrage, habe ich das im Hinterkopf und versuche diese Informationen gleich miteinzubauen.
Okay, genug geplaudert *gg*
Alt+F11, Doppelklick auf den Blattnamen, Code einfügen, Editor schließen.
Die Codezeile
.Range(.Cells(ZeiQ, 2), .Cells(ZeiQ, 12)).Copy Destination:=wksZ.Cells(ZeiZ, 1)
gibt an daß die Zellen der jeiligen Zeilen von 2te bis 12te Spalte kopiert werden, ggfs. anpassen.
Nachstehend der Code, hier eine Beispielmappe wo es demonstriert wird, ändere was in „Tabelle1“ und schau dir dann die beiden anderen Blätter an.
http://www.hostarea.de/server-09/September-75ab08d7b…
Gruß
Reinhard
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim colC As New Collection, C As Long, Zelle As Range
Dim wksQ As Worksheet, wksZ As Worksheet, ZeiZ As Long, ZeiQ As Long
Set wksQ = Worksheets("Tabelle1")
On Error Resume Next 'wegen colc.add
For Each Zelle In Target
colC.Add Item:=Cells(Zelle.Row, 1).Value, key:=Cells(Zelle.Row, 1).Value
Next Zelle
On Error GoTo 0
With wksQ
For C = 1 To colC.Count
On Error GoTo BlattNichtDa
Set wksZ = Worksheets(colC(C))
On Error GoTo 0
wksZ.UsedRange.ClearContents
ZeiZ = 2
For ZeiQ = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(ZeiQ, 1) = colC(C) Then
.Range(.Cells(ZeiQ, 2), .Cells(ZeiQ, 12)).Copy Destination:=wksZ.Cells(ZeiZ, 1)
ZeiZ = ZeiZ + 1
End If
Next ZeiQ
Next C
End With
Exit Sub
BlattNichtDa:
MsgBox "Blatt " & colC(C) & " gibt es nicht!"
End Sub
