Option Explicit
Sub transfert()
Dim F1 As Range
Dim F2 As Worksheet
Dim i As Integer
Dim Desti
Dim DernLigneF1 As Long
Application.ScreenUpdating = False
DernLigneF1 = Sheets("source").Range("A" & Rows.Count).End(xlUp).Row
Set F1 = Sheets("source").Range("A1:A" & DernLigneF1)
Set F2 = Sheets("Archive")
For i = F1.Rows.Count To 4 Step -1
If F1.Cells(i, 11).Value = "A" Then
Set Desti = F2.[A65000].End(xlUp)
Rows(i).EntireRow.Cut Destination:=Desti(2): Rows(i).EntireRow.Delete Shift:=xlUp
End If
Next i
Range("a3").Select
ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Archive").Sort.SortFields.Add Key:=Range("A3"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Archive").Sort
.SetRange Range("A4:M8")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub