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