Zeilen inhaltsbedingt in eine neue tabelle einfügen

jodahush

Grünschnabel
Hallo

ich möchte aus einer Tabelle in der ich Inhalte einer Zelle nach (offen, in klärung, umsetzbar) bezeichnen kann, Inhaltsbedingt Zeilen in ein andere Tabelle kopieren.

Beispiel

R1 hose grün umsetzbar
R2 rock rot in klärung

Hier soll nun R1 in die Tabelle umsetzbar kopiert, R2 in Tabelle in Klarüng kopiert werden.




Hier ist der Code

Sub Kopiere_Daten()
'Kopiere_Daten 7.5.08 von Hermann Hehn
Dim Wohin, zbez
Dim Leer
Dim x, y, z

Application.ScreenUpdating = False


Worksheets("umsetzbar").Range("A1:z200").ClearContents
Worksheets("offen").Range("A1:z200").ClearContents
Worksheets("in Klärung").Range("A1:z200").ClearContents

'Verteile Header
'kopiere Reihe 3 und 4
Rows("3:4").Select
Selection.Copy
'Gehe in die 3 Sheets und füge die Überschriften ein
Sheets("Umsetzbar").Select
Rows("1:1").Select
ActiveSheet.Paste
Sheets("Offen").Select
Rows("1:1").Select
ActiveSheet.Paste
Sheets("In Klärung").Select
Rows("1:1").Select
ActiveSheet.Paste
Sheets("Backup").Select
Rows("1:1").Select
ActiveSheet.Paste
' Sheets("Tabelle1").Select
' Rows("1:1").Select
' ActiveSheet.Paste


'Verteile Daten
'gib den Variablen irgend einen Wert
y = 1
z = 20
'Suche die erste freie Reihe
Sheets("NGF-TPM-ZW-Auftragsliste").Select
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
z = ActiveCell.Row

For x = 5 To z
Sheets("NGF-TPM-ZW-Auftragsliste").Select
Cells(x, 6).Select
Wohin = ActiveCell.Value
'lese wert aus zelle
'markiere reihe x
Rows(x).Select
Application.CutCopyMode = False
Selection.Copy
If Wohin = "" Then Exit For
'ab hier pasten


Sheets(Wohin).Select

'find next empty row
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
y = ActiveCell.Row

Sheets(Wohin).Rows(y).Select
ActiveSheet.Paste

Next x


Sheets("NGF-TPM-ZW-Auftragsliste").Select
Cells(1, 1).Select

Application.ScreenUpdating = True
End Sub
 
Zuletzt bearbeitet:
Eigentlich habe ich den Thread permanent miteditiert, so das die meisten Probleme schon gelöst sind.
Daher mache ich einen neuen Thread
 
Zuletzt bearbeitet:
Zurück