Archivierung von Excel Zeilen

[Maurice511]

Hallo,

ich habe folgende Situation:

Ich habe in mehreren Zellen innerhalb einer Zeile etwas stehen. Nun benötige ich eine Funktion, die es mir erlaubt, eine Zeile der Ursprungstabelle in eine zweite Tabelle zu archivieren. Dies soll genau dann erfolgen, wenn ich ein "x" hinter die letzte beschriebene Zelle einer Zeile der Ursprungstabelle schreibe. Alle "x" befinden sich dabei zum Beispiel in Spalte "E".
Wenn die Zeile in der Ursprungstabelle gelöscht wird soll dies keine Auswirkung auf die neue Tabelle haben.

Ich hoffe, dass mir jemand weiterhelfen kann und bedanke mich im Voraus!

Eine kleine Anmerkung noch: Es gibt bei Google einige VBA-Anleitungen, bei denen nicht ersichtlich wird, welche Textelemente individuell angepasst werden müssen. Daher wäre es sehr gut, wenn die Variablen ganz eindeutig gekennzeichnet werden

Viele Grüße
Maurice

[WillWissen]

Hi Maurice,

filtere die entsprechende Spalte nach "x", kopiere sie und füge sie als Werte in dein neues Tabellenblatt ein. Das Kopieren und Einfügen kannst du ja als Makro aufzeichnen und hier zur Verallgemeinerung hochladen.

[Gast 123]

Hallo Maurice

anbei ein kurzes Makro mit dem du kopieren kannst.  Bitte zuerst in einer Testdatei ausprobieren. Ich lösche die alte Liste in Tabelle2 nicht, sondern haenge die neuen Werte immer unten dran. Sollten die Tabellen anders lauten wie "Tabelle 1+2" musst du die Namen hinter Const aendern. Mein Programm setzt voraus das in Spalte A immer ein Wert steht. (für die LastZell suche)  Rückmeldung ob es klappt waere nett. 

mfg  Gast 123

Code:

Option Explicit         '30.11.2016  Gast 123  Clever Forum

Const QTb = "Tabelle1"  'Quell Tabelle   (Name selbst einfügen)
Const ZTb = "Tabelle2"  'Ziel Tabelle

Sub kopieren()
Dim AC As Object, z As Long
Dim Qlz As Long, Zlz As Long
z = Worksheets(QTb).Rows.Count

'letzte Zelle in Spalte A suchen  (nach oben)
Qlz = Worksheets(QTb).Cells(z, "A").End(xlUp).Row
Zlz = Worksheets(ZTb).Cells(z, "A").End(xlUp).Row

'Schleife zum Prüfen nach "x" in Spalte E
For Each AC In Worksheets(QTb).Range("E1:E" & Qlz)
If AC.Value = "x" Or AC.Value = "X" Then
 Zlz = Zlz + 1
 'kopiere Quell-Zeile von Spalte A bis D
 Worksheets(QTb).Cells(AC.Row, 1).Resize(1, 4).Copy
 Worksheets(ZTb).Cells(Zlz, 1).PasteSpecial xlPasteValues
 Application.CutCopyMode = False
End If
Next AC
End Sub

[Maurice511]

Guten Morgen,


vielen Dank für die Tipps.

Gast123, leider kommt folgende Fehlermeldung, wenn ich die Datei abspeichern möchte:

[
Bild bitte so als Datei hochladen: Klick mich!
]

Da ich noch absoluter Anfänger bin, was VBA betrifft, bitte ich um kurze Rückmeldung, was ich hier falsch gemacht habe.

Viele Grüße
Maurice

[BoskoBiati]

Hallo,

Dateien mit Makros müssen als .xlsm abgespeichert werden. Also nein anklicken und die richtige Endung auswählen.

[Maurice511]

Hallo,

das Makro funktioniert bestens, vielen Dank für eure Hilfe!

Beste Grüße
Maurice