Zeilen vergleichen und kopieren

Hallo Zusammen,
ich hoffe ihr könnt mir bei meinem Problem helfen. Da ich nur VBA Grundkenntnisse habe, ist es etwas zu komplex für mich..
Hier ist schon mal die Beispieldatei:
https://www.herber.de/bbs/user/97713.xlsm
Ich habe 4 Tabellenblätter. Im TB "Ursprungsbuchungen", die alle ein bestimmtes Label haben (Spalte A).
In manchen Fällen taucht diese Ursprungsbuchung (manchmal leicht verändert) auch in den beiden Tabellenblättern "Weltbuchung" und "C3 Buchung" auf. Im TB "Weltbuchung" würde im Label zusätzlich ein "W" vorne dran stehen und im TB "C3 Buchung" ein "C3".
Ziel ist es die Buchungen im TB "Gesamtübersicht" zu sortieren. D.h. jede Ursprungsbuchung soll in die Gesamtübersicht kopiert werden. Wenn es zu der Buchung auch eine W- oder C3- Buchung gibt, soll diese direkt darunter kopiert werden. Dann eine Leerzeile, dann die nächste Buchung. Sodass am Ende in der Gesamtübersicht alle Buchungen aus allen 3 TB auftauchen und die mit dem gleichen Label untereinander stehen.
In der Beispieldatei habe ich das mal manuell gemacht, wie es am Ende aussehen soll.
Ich hoffe das war einigermaßen verständlich und mir kann jemand helfen...
Viele Grüße,
Tanja

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Tanja,
ich kopiere erst alles untereinander und schreibe ein paar Hilfsspalten für die automatische Sortierung in Excel.
Hier das Makro:


Option Explicit
Sub kopieren()
Dim von%, z0%, z%, i%, bis%, n%
Dim bez$
z0 = 2
z = z0
' 1. alles zusammenkopieren...
Sheets("Ursprungsbuchung").Activate
bis = Range("a1").End(xlDown).Row
von = 2
Range("A" & von & ":E" & bis).Copy Sheets("Gesamtübersicht").Range("a" & z)
z = z + bis - von + 1
Sheets("Weltbuchung").Activate
bis = Range("a1").End(xlDown).Row
von = 2
Range("A" & von & ":E" & bis).Copy Sheets("Gesamtübersicht").Range("a" & z)
z = z + bis - von + 1
Sheets("C3 Buchung").Activate
bis = Range("a1").End(xlDown).Row
von = 2
Range("A" & von & ":E" & bis).Copy Sheets("Gesamtübersicht").Range("a" & z)
z = z + bis - von
Sheets("Gesamtübersicht").Activate
' 2. Hilfsspalten für Sortierung
For i = z0 To z
n = 1
bez = Range("A" & i)
If Mid(bez, 1, 1) = "W" Then
n = 2
bez = Mid(bez, 2)
End If
If Mid(bez, 1, 1) = "C" Then
n = 3
bez = Mid(bez, 3)
End If
Range("F" & i) = n
Range("G" & i) = i
Range("H" & i) = bez
Next
' 3. Sortieren
Range("A" & z0 & ":H" & z).Sort key1:=Range("H" & z0), key2:=Range("F" & z0), key3:=Range("G" &  _
z0)
' 4. Leerzeilen markieren ...
Range("G" & z0 + 1).FormulaLocal = "=H3H2"
Range("G" & z0 + 1).Copy Range("G" & z0 + 2 & ":G" & z)
' und einfügen
For i = z0 + 1 To 2 * z
If Range("G" & i) Then
Range("G" & i).EntireRow.Insert
Range("A" & i & ":E" & i).Interior.Color = xlNone
i = i + 1
End If
Next
' 5. Hilfsspalten entfernen
End Sub

und die Datei: https://www.herber.de/bbs/user/97747.xlsm
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen vergleichen und kopieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread