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
Workbooks.Open strPath & "\Y.xlsx"
Set wbY = ActiveWorkbook
Set wsX = wbX.Sheets("Tabelle1")
Set wsY = wbY.Sheets("Tabelle1")
lngLastRowY = wsY.Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowX = wsX.Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
For lngCounter = 1 To lngLastRowY
With wsY
If .Cells(lngCounter, 20).Value = "new" Then
.Cells(lngCounter, 1).EntireRow.Copy
lngLastRowX = wsX.Cells(Rows.Count, 1).End(xlUp).Row
wsX.Cells(lngLastRowX + 1, 1).PasteSpecial xlPasteAll
End If
End With
Next lngCounter
wbY.Close
Application.DisplayAlerts = True
End Sub