Zeilen vergleichen und einfügen

salü zusammen
in einer datei mit 2 identisch aufgebauten tabellen habe ich jeweils die personaldaten (name, vorname, adresse, etc.) aufgelistet. nun möchte ich per makro die adressänderungen welche in der einen tabelle ausgeführt werden in der zweiten ergänzen bzw. überschreiben. ursprünglich sind die tabellen in zwei verschiedenen dateine welche ich zur überprüfung in eine datei kopiere (tabellenblatt1 und tabellenblatt2)
die spalte e soll zwischen der tabelle1 und tabelle2 verglichen werden. wenn die werte (personalnamen) übereinstimmen, soll der zeilenbereich a bis k der tabelle1 in die tabelle3 und die zeilenbereiche l bis az der tabelle2 in die tabelle3 eingetragen werden.
wenn die werte einer zelle in der spalte e nicht übereinstimmen dann soll jeweils eine zeile in der tabelle3 eingefügt werden welche die daten aus tabelle1 enthält.
ich hoffe es klingt nicht alzu kompliziert.
wie kann ich das bewerkstelligen? wäre super, wenn mir jemand auf die sprünge helfen könnte oder ev sogar einen entsprechenden code hätte.
vielen dank
gruss andi

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andi,
Versuch mal folgenden Code:


Sub Tabvergleich()
Dim xx As Worksheet, yy As Worksheet, zz As Worksheet
Dim i As Long, j As Long, k As Long
Dim LRTab1 As Long, LRTab2 As Long
Set xx = Worksheets("Tabelle1")
Set yy = Worksheets("Tabelle2")
Set zz = Worksheets("Tabelle3")
xx.Select
Cells.Select
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
yy.Select
Cells.Select
Selection.Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For i = 1 To Rows.Count
If xx.Cells(i, 5) = "" Then Exit Sub
For j = 1 To Rows.Count
If yy.Cells(j, 5) = "" Then
k = k + 1
xx.Activate
xx.Rows(i).Copy
zz.Activate
zz.Rows(k).Select
ActiveSheet.Paste
Exit For
End If
If yy.Cells(j, 5) = xx.Cells(i, 5) Then
k = k + 1
xx.Activate
xx.Range(Cells(i, 1), Cells(i, 11)).Copy
zz.Activate
zz.Range(Cells(k, 1), Cells(k, 11)).Select
ActiveSheet.Paste
yy.Activate
yy.Range(Cells(j, 12), Cells(j, 48)).Copy
zz.Activate
zz.Range(Cells(k, 12), Cells(k, 48)).Select
ActiveSheet.Paste
Exit For
End If
Next
Next
End Sub

Der Makro funktioniert wenn in Tabelle1 mindestens soviel Zeilen vorhanden sind wie in Tabelle2. Tabelle1 kann auch größer als Tabelle2 sein.
Ich gehe davon aus, daß der Spaltenaufbau aller Tabellen gleich ist !
Des Weiteren gehe ich davon aus, daß der Zeilenbereich von "L" bis "AZ" gehen soll.
Du schreibst er solle von "I" bis "AZ" gehen. Dabei würden aber bereits kopierte Daten
von der Tabelle1 überschrieben werden (...zeilenbereich a bis k der tabelle1 in die tabelle3 ...). Macht eigentlich keinen Sinn !! Ich habe es jetzt so realisiert, das der Bereich "L" bis "AZ" der Tabelle2 kopiert wird.
Gruß Manfred

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread