Can’t remove blank rows

This code tests for any blank rows. If the entire row is blank, then it copies the data in columns A:S to Sheet2. You have a link to an outside worksheet. This interferes with the code. You may wish to break the link before running the code.

Option Explicit

Sub foo()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i As Long, lr As Long, lr2 As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 1 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If WorksheetFunction.CountA(Range("A" & i & ":S" & i)) <> 0 Then
            s1.Range("A" & i & ":S" & i).Copy s2.Range("A" & lr2 + 1)
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub