|
Hallo hilfloserNeuling :-)
Dieser Code macht das, was Du benötigst:
Voraussetzung:
Die Datei mit den Infomationen heißt tatsächlich Y.xlsx und ist im gleichen Pfad, wie diese Datei gespeichert. Ansonsten den Namen anpassen.
Option Explicit
Sub CheckForNewAndCopy()
Dim wbX As Workbook, wbY As Workbook
Dim wsX As Worksheet, wsY As Worksheet
Dim strPath As String
Dim lngLastRowX As Long, lngLastRowY As Long, lngCounter As Long
Set wbX = ThisWorkbook
strPath = wbX.Path
'Öffnen des Workbooks Y
Workbooks.Open strPath & "\Y.xlsx"
Set wbY = ActiveWorkbook
Set wsX = wbX.Sheets("Tabelle1")
Set wsY = wbY.Sheets("Tabelle1")
'letzte verwendete Zeile jeweils in "Tabelle1" in den Workbooks X & Y ermitteln
lngLastRowY = wsY.Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowX = wsX.Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
'Durchlauf aller verwendeten Zeilen in Tabelle1 im Workbook Y
For lngCounter = 1 To lngLastRowY
With wsY
'Prüfen, ob in Spalte T (Spalte 20) der Befriff "new" steht
If .Cells(lngCounter, 20).Value = "new" Then
'Falls ja wird die gesamte Zeile kopiert
.Cells(lngCounter, 1).EntireRow.Copy
'Ermittlung der jeweils letzten verwendeten Zeile im Workbook X
lngLastRowX = wsX.Cells(Rows.Count, 1).End(xlUp).Row
'und in die erste nicht verwendete Zeile in Tabelle1 im Workbook X eingefügt
wsX.Cells(lngLastRowX + 1, 1).PasteSpecial xlPasteAll
End If
End With
Next lngCounter
'Schließen von Workbook ohne zu speichern
wbY.Close
Application.DisplayAlerts = True
End Sub
Viele Grüße
Kai
|