Why are you opening/closing the destination workbook every time you want to copy a row to it?
Open it once, then run through the source data copying what's required and then close it.
Try this.
Sub CopyToBackupFile()
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim wsSrc As Worksheet
Dim LastRow As Long, i As Long
Set wsSrc = ActiveSheet
LastRow = wsSrc.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Set wbDst = Workbooks.Open(Filename:="C:\Users\My\Desktop\Backup.xlsx")
Set wsDst = wbDst.Worksheets("Sheet1").Select
For i = 4 To LastRow
If wsSrc.Cells(i, 1) <> "" Then
wsSrc.Cells(i, 1).Resize(, 16).Copy wsDst.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next i
wbDst.Close SaveChanges:=True
Application.ScreenUpdating = True
End Sub
Bookmarks