Zeilen nach Kriterien in neues Tabellenblatt kopie

Hallo an alle,
Ich habe folgendes Problem:
Ich habe ein Tabellenblatt in dem Daten in verschiedenen Spalten stehen.
Nun sollen diese Daten nach zum Beispiel den Einträgen in Spalte D durchsucht werden und in neue Tabellenblätter eingefügt werden. In Spalte D stehen drei unterschiedliche Werte. z.B. 817, 834 und 843. Die Spalte soll durchsucht werden und alle Zeilen mit dem Wert 817 sollen z.B. in Tabelle2 kopiert werden. Wenn ein zweiter Wert gefunden wird mit 817 soll dieser in die nächste Zeile der Tabelle2 kopiert werden. Ebenso für die beiden anderen Werte in Spalte D diese sollen aber auch in eigenständige Tabellenblätter kopiert werden.
Hoffe ich hab es verständlich geschrieben :-)
Danke für eure Hilfe schon im Voraus.
Gruss
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
das folgende Makro kopiert die Einträge aus Tabelle1 nach Tabelle2 (817), Tabelle3 (834) bzw. nach Tabelle4 (843):


Sub kopieren()
Dim rng As Range, ziel As Range
With ThisWorkbook
For Each rng In .Sheets("Tabelle1").Range("D1:D" & .Sheets("Tabelle1") _
.Range("D65536").End(xlUp).Row)
Select Case rng
Case 817
Select Case Len(.Sheets("Tabelle2").Range("D1"))
Case 0
Set ziel = .Sheets("Tabelle2").Range("D1")
Case Else
Set ziel = .Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0)
End Select
Case 834
Select Case Len(.Sheets("Tabelle3").Range("D1"))
Case 0
Set ziel = .Sheets("Tabelle3").Range("D1")
Case Else
Set ziel = .Sheets("Tabelle3").Range("A65536").End(xlUp).Offset(1, 0)
End Select
Case 843
Select Case Len(.Sheets("Tabelle4").Range("D1"))
Case 0
Set ziel = .Sheets("Tabelle4").Range("D1")
Case Else
Set ziel = .Sheets("Tabelle4").Range("A65536").End(xlUp).Offset(1, 0)
End Select
End Select
On Error GoTo Fehlerbehandlung
rng.EntireRow.Copy Destination:=ziel.Offset(0, -3)
Next 'rng
End With
Exit Sub
Fehlerbehandlung:
Select Case Err.Number
Case 1004
rng.Parent.Activate
rng.Activate
MsgBox "Die Tabelle " & Chr(34) & ziel.Parent.Name & Chr(34) & _
" ist voll. Kopiervorgang abgebrochen. Die Zeilen vor der Markierung wurden jedoch kopiert."
End Select
End Sub

Gruß Ingolf

Beliebteste Forumthreads (12 Monate)

Zeilen nach Kriterien in neues Tabellenblatt kopie

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen nach Kriterien in neues Tabellenblatt kopie

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread