Copier/Coller en boucle avec condition

Sub test()
Dim cpt1%, cpt2%
cpt2 = 1
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For cpt1 = 1 To .Range("A65536").End(xlUp).Row
        If .Range("P" & cpt1) = "OK" Then
            .Range("A" & cpt1 & ":P" & cpt1).Copy
            Sheets("Feuil2").Range("A" & cpt2).PasteSpecial xlValues
            Sheets("Feuil2").Range("A" & cpt2).PasteSpecial xlFormats
            cpt2 = cpt2 + 1
        End If
    Next cpt1
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Sub Archivage()

Dim MSG As Long, rd As Range, rs As Range

MSG = MsgBox("Cette action va archiver !." _
& vbNewLine & " " & vbNewLine & "Effacer les actions et archiver ?", _
vbQuestion + vbYesNo, "Information")

If MSG = vbYes Then

Application.ScreenUpdating = False

With Sheets("Archive")
    UnProtect 'Module Protection
End With

With Sheets("Suivi")

    UnProtect 'Module Protection
    
    For cpt = 7 To .Range("A65536").End(xlUp).Row
    
        Set rd = Sheets("Archive").Range("A65536").End(xlUp).Offset(1, 0)
        Set rs = .Range("A" & cpt & ":P" & cpt)
            
            If .Range("P" & cpt) = "OK" Then
                rs.Copy
                rd.PasteSpecial xlValues
                rd.PasteSpecial xlFormats
                rs.Delete
            End If
    
    Next cpt
    
    Protect 'Module Protection
        
End With

Application.CutCopyMode = False

With Sheets("Archive")
    Protect 'Module Protection
End With

Application.ScreenUpdating = True

End If

End Sub