ich kann meinen Knoten gerade nicht lösen - ich möchte aus (Arbeitsmappe 1 - Tabelle1 - Spalte B bis letzte Zeile) Werte vergleichen mit (Arbeitsmappe 2 - Tabelle1 - Spalte B bis letzte Zeile). Ist der Wert nicht vorhanden, soll er in die erste freie Zeile von Arbeitsmappe 2 - Tabelle 1 angefügt werden.
Das funktioniert mit meinem Code nicht: Sind in Arbeitsmappe 2 mehr Werte als in Arbeitsmappe 1 _ werden die kompletten Werte aus Arbeitsmappe 1 erneut ans Ende in Arbeitsmappe 2 gestellt. Gleiches gilt bei Veränderung der Reihenfolge in der Quellmappe.
Public Sub Uebertrag()
'Plan öffnen
Application.ScreenUpdating = False
Const LW = "C:\"
Const Pfad = "C:\Daten\"
Const Datei = "Mappe1.xlsx"
ChDrive LW
ChDir Pfad
Workbooks.Open Datei
Dim letzteQ As Long
Dim letzteZ As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Workbooks("Mappe1.xlsx").Sheets(1)
Set wksZ = Workbooks("Sammlung.xlsm").Sheets(1)
Dim zeile As Long, Suchzeile As Long
'letzte Zeile in Quelle und Ziel ermitteln
letzteQ = wksQ.Cells(wksQ.Rows.Count, 2).End(xlUp).Row
letzteZ = wksZ.Cells(wksZ.Rows.Count, 2).End(xlUp).Row + 1
'Spalten durchlaufen und bei Treffer nächste Zeile
For zeile = 2 To letzteZ
For Suchzeile = 2 To letzteQ
If wksQ.Cells(Suchzeile, 2) = wksZ.Cells(zeile, 2) Then
zeile = zeile + 1
Else
'wenn nicht vorhanden - Wert ans Ende in Ziel
wksZ.Cells(letzteZ, 2) = wksQ.Cells(Suchzeile, 2)
letzteZ = letzteZ + 1
End If
Next Suchzeile
Next zeile
Set wksQ = Nothing
Set wksZ = Nothing
'Quelldatei schließen
Workbooks(Datei).Close
Application.ScreenUpdating = True
End Sub
Könnt ihr mir da behilflich sein? Mit der .find-Methode hatte ich auch probiert - bin aber an meine Grenzen gestoßen.Gruß Vic