Office: Zeilen mit bestimmten Merkmal ausschneiden,einfügen &lös

Hi!

Ich hoffe Ihr könnt mir helfen!

Folgendes Problem:

Ich möchte in einer Tabelle allle Zeilen, die zwei bestimmte, unterschiedliche Merkmale (in den Spalten Z & AH) haben, ausschneiden oder kopieren, in Tabellenblatt 3 einfügen und die Ursprungszeile dann löschen.

Habe das ganze schon über ein Makro versucht zu lösen, dass mit einem AutoFilter arbeitet, aber da werden die Daten nicht kopiert.

Habe mich mal etwas umgeschaut, was sonst noch funktionieren könnte, wobei ich auf die DoLoopWhile öglichkeit gestoßen bin. Habe mit meinen etwas beschränkten VBA Kenntnissen auch versucht etwas zusammen zu basteln, aber da hat leider gar nichts funktioniert :)

Die Krönung wäre es, wenn das ganze in Tabellenblatt 3 in die erste komplett unbeschriebene Zeile eingefügt würde, aber ich wäre schon überglücklich wenn die ersten Schritte einfach nur funktionieren würden...

Vielen Dank schon mal für eure Hilfe!

Grüße

Mathias

 

Re: Zeilen mit bestimmten Merkmal ausschneiden,einfügen &amp

Hallo Mathias,

ich gehe davon aus, dass Du mit "Merkmale" den Zellwert, und nicht die Farbe, Formatierung o.ä. meinst.

Benötigst Du dafür denn unbedingt ein Makro?
Musst Du diese Aktion öfters benutzen, oder nur einmal?
Denn wenn Du es nur einmal brauchst, reicht doch auch:
- Reiter: Start - Sortieren und Filtern - Filtern
- dann die beiden Spalten auf das entsprechende Merkmal Filtern
- alle Zeilen markieren > ausschneiden > Blatt wechseln > ausgeschnittene Zellen einfügen
- wieder Blatt wechseln und Filter entfernen
Feddich.


Falls Du die Aktion mehrfach benötigst, kannst Du es ja mal mit unten stehendem Code probieren.
Folgendes ist dabei wichtig:
- sowohl Quell- als auch Zielblatt sind nicht geschützt
- beide Blätter sind in der gleichen Datei
- auf beiden Blättern wird nach der letzten beschriebenen Zelle in Spalte A gesucht
- Du musst im Code noch Deine Merkmale bei Kriterium1 & 2 einfügen (anstelle von x & y)

Da Du die Zeilen in Tabelle3 scheinbar in Reihenfolge haben möchtest, und ich nicht weiß ob Du das nachträglich sortieren kannst oder willst, habe ich hilfsweise eine zweite Schleife benutzt, die erstmal die Anzahl der zu kopierenden Zeilen ermittelt.
Falls Du sehr große Datenmengen bearbeiten willst (extrem viele Zeilen), kann dies zu einem Geschwindigkeitsverlust führen.

Kopiere folgenden Code in das Modul des Blattes, indem sich die Daten befinden, die Du durchsuchen und filtern willst. (NICHT ins Modul von Tabelle3 !!!):

Code:

Option Explicit

Public Sub ZeilenFilternUndVerschieben()
Dim loLetzte As Long
Dim loLetzteTab3 As Long
Dim loAnzahl As Long
Dim loCounter As Long
Dim strKriterium1 As String
Dim strKriterium2 As String

loAnzahl = 0
strKriterium1 = "x"     ' bezieht sich auf Spalte Z (Spaltennummer 26)
strKriterium2 = "y"     ' bezieht sich auf Spalte AH (Spaltennummer 34)
    
    With ThisWorkbook.Worksheets("Tabelle3")
        loLetzteTab3 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
    End With
    
    With Me
        loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
        For loCounter = 1 To loLetzte
            If .Cells(loCounter, 26).Value = strKriterium1 And _
                .Cells(loCounter, 34).Value = strKriterium2 Then
                loAnzahl = loAnzahl + 1
            End If
        Next loCounter
        For loCounter = loLetzte To 1 Step -1
            If .Cells(loCounter, 26).Value = strKriterium1 And _
                .Cells(loCounter, 34).Value = strKriterium2 Then
                .Rows(loCounter).EntireRow.Cut Destination:=ThisWorkbook.Worksheets("Tabelle3").Rows(loLetzteTab3 + loAnzahl)
                .Rows(loCounter).EntireRow.Delete shift:=xlUp
                loAnzahl = loAnzahl - 1
            End If
        Next loCounter
    End With
    
End Sub

Frag ruhig, falls noch etwas unklar sein sollte.

Ich hoffe geholfen zu haben.

 

Halleluja, es funktioniert :) Vielen Vielen Dank, das war eine riesen Hilfe und hat mich die ganzen letzten Tage beschäftigt...

Eine Frage habe ich allerdings noch: Gibt es auch eine Möglichkeit die erste Zeile zu finden, die zwar in A unbeschrieben ist, in B allerdings beschrieben. Oder allgemeiner: Ich habe zu dieser Fragestellung immer nur Codes gefunden, die in der ersten Spalte suchen, kann man dafür auch eine andere Spalte definieren?

Grüße

Mathias

 

Hallo Mathias,

das einfachste dürfte in diesem Fall eine Abfrage mit "UsedRange" sein.
"UsedRange" = benutzter Bereich

Ändere folgende Zeile:

Code:

loLetzteTab3 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)

in diese um:

Code:

loLetzteTab3 = .UsedRange.Rows.Count + 1

und folgende Zeile:

Code:

loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)

in diese:

Code:

loLetzte = .UsedRange.Rows.Count + 1

Dann sollte es eigentlich so klappen wie Du möchtest.

Falls Du den Code nicht mit Copy/Paste aus dem Forum in die Datei überträgst, sondern eintippst, achte genau wo ich Punkte gesetzt habe.
Die werden schnell vergessen oder übersehen, sind aber wichtig für die Referenzierung.

Ich hoffe geholfen zu haben.

Edit:
Was ist denn nun mit der Sortierung?
Können die kopierten Daten in Tabelle 3 nachträglich sortiert werden?
Dann könnte man den ganzen Code noch vereinfachen und die erste Schleife entfernen.
Dafür wäre aber wichtig zu wissen, ob nur die kopierten Daten, oder das ganze Blatt sortiert werden darf/soll, und nach welchen Kriterien, sowie ob auf- oder absteigend.

Oder man lässt den Aufbau mit der Doppelschleife so, wenn Du keine Geschwindigkeitsprobleme hast.

Kannst Dich ja mal dazu äußern.

 

Hallo Achim!

Vielen Dank für die Amtwort! Das funktioniert perfekt mit UsedRange.

Zur Sortierung: Das muss nicht sein, ist so aber in Ordnung. In meiner Liste mit ca. 3000 Datensätzen läuft das ganze in ein paar Sekunden durch. Sollten es mal mehr Daten werden, entferne ich einfach die erste Schleife.

Vielen Dank nochmal für die Hilfe!

Liebe Grüße

Mathias

 

Dankeschön!
Hatte dieses Problem auch schon seit paar Tagen, endlich hab ich die Lösung gefunden!
Diese Seite ist der Wahnsinn.
Aber wer Jobs sucht bitte hier entlang.

Liebe Grüße