Macro to Cut "Completed" Rows from Sheet 1 and Paste in Sheet 2

Hi. I am trying to formulate a macro that will look for rows where the status of a task is marked complete. I would then like to cut those rows from Active and paste them in the next available rows in completed. Here is the code I have so far.

Option Explicit
Option Base 1

Sub FilterCompleted()
    Dim LR As Long, r As Integer, i As Integer
    Dim putIn As String
    Dim arrCriterial As Variant
    
    arrCriterial = Array("Completed")
    Range("E3").AutoFilter
    For i = 1 To UBound(arrCriterial)
        Range("E3").AutoFilter Field:=5, Criteria1:="=*" & arrCriterial(i) & "*"
        LR = Range("A" & Rows.Count).End(xlUp).Row
        
        If LR > 1 Then
            putIn = Sheets("Active").Cells(r + 1, 1).Address
            Range("A1:G" & LR).Copy Sheets("Completed").Range(putIn)
            r = Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Row + 1
        End If
        
        Rows("3:" & LR).Delete Shift:=xlUp
        Range("E3").AutoFilter
    Next i
    Range("A1").Select
End Sub

I am having two problems (that I can identify) with the code so far:

1: On the initial run it correctly identifies the completed cell, but it pastes them over the top of my headings in Completed; and
2: If I run it again and there are not completed items in Active, it cuts my headings out and pastes them in row 1 of Completed.

test 2.xlsm

Sub Converted()
    Dim LR&
    Application.ScreenUpdating = False
    With Sheets("Active")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:F" & LR).AutoFilter 5, "Completed"
        .Range("A1:F" & LR).Copy
        Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
        Application.CutCopyMode = True
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

AB33 - Thanks for the help. Code didn't quite accomplish what I wanted but it got me pointed in the right direction. Here is the code as finished

Option Explicit
Option Base 1

Sub FilterCompleted()
Dim LR As Long

Application.ScreenUpdating = False
If Application.WorksheetFunction.CountIf(Sheets("Active").Range("E3:E4000"), "Completed") > 0 Then

With Sheets("Active")
    LR = Range("A" & Rows.Count).End(xlUp).Row
    .Range("A2:G" & LR).AutoFilter 5, "Completed"
    .Range("A3:G" & LR).Copy Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Rows("2:" & LR).Delete Shift:=xlUp
    Application.CutCopyMode = True
    .AutoFilterMode = False
    
End With

Application.ScreenUpdating = True

Else

Application.ScreenUpdating = True

End If

End Sub