Copy and paste rows from one to another worksheet VBA - vba

Question

I know already a few people had that problem but their solutions did not help me. I am pretty new to VBA and I want to copy a row if the respective first cell is not empty to another file and iterate as long as the data is.
So far so good. My code runs the first time and actually works (for one line). But then the macro does not open the file again and spits out an error. If I want to manually open the target file it says: "Removed Feature: Data Validation from /xl/worksheets/sheet2.xml part" (and I think this is the reason why it does not iterate further). Do you have any idea what I can do?
Sub transferData()
Dim LastRow As Long, i As Integer, erow As Long
LastRow = ActiveSheet.Range("BC" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
If IsEmpty(Cells(i, 63).Value) = False Then
Range(Cells(i, 55), Cells(i, 63)).Select
Selection.Copy
Workbooks.Open Filename:="PATH.xlsx"
Worksheets("NewProjects").Select
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(erow, 1).Select
ActiveSheet.PasteSpecial
ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.Save
ActiveWorkbook.Close SaveChanges:=False
Application.CutCopyMode = False
End If
Next i
End Sub

Answer 1

Data Validation for the file is corrupt (dropdown lists) - either delete Data Validation, or fix it
Once the file is fixed, the code bellow will copy the data without opening the destination file multiple times. It AutoFilters current sheet for empty values in column BK (63), and copies all visible rows, from columns BC to BK, to the end of the new file (starting at first unused cell in column A)
Option Explicit
Public Sub TransferData()
Const OLD_COL1 = "BC"
Const OLD_COL2 = "BK"
Const NEW_COL1 = "A"
Dim oldWb As Workbook, oldWs As Worksheet, oldLR As Long
Dim newWb As Workbook, newWs As Worksheet, newLR As Long
On Error Resume Next 'Expected errors: new file not found, new sheet name not found
Set oldWb = ThisWorkbook
Set oldWs = ActiveSheet 'Or: Set oldWs = oldWb.Worksheets("Sheet2")
oldLR = oldWs.Cells(oldWs.Rows.Count, OLD_COL1).End(xlUp).Row
Application.ScreenUpdating = False
Set newWb = Workbooks.Open(Filename:="PATH.xlsx")
Set newWs = newWb.Worksheets("NewProjects")
If Not newWs Is Nothing Then
newLR = newWs.Cells(oldWs.Rows.Count, NEW_COL1).End(xlUp).Row
With oldWs.Range(oldWs.Cells(2, OLD_COL2), oldWs.Cells(oldLR, OLD_COL2))
.AutoFilter Field:=1, Criteria1:="<>"
If .SpecialCells(xlCellTypeVisible).Cells.Count > 2 Then
oldWs.Range(oldWs.Cells(3, OLD_COL1), oldWs.Cells(oldLR, OLD_COL2)).Copy
newWs.Cells(newLR + 1, NEW_COL1).PasteSpecial
Application.CutCopyMode = False
newWs.Sort.SortFields.Clear
newWb.Close SaveChanges:=True
Else
newWb.Close SaveChanges:=False
End If
.AutoFilter
End With
End If
Application.ScreenUpdating = True
End Sub