Vba code to append in Excel

Sub CopyFilteredRow()
Dim SrcWs As Worksheet, DestWs As Worksheet
Dim SrcLR As Long, DestLR As Long
Dim j As Long, i As Long
Dim Crit(6) As String
Dim StrIF As String
Dim RngFilter As Range, CopyRng As Range

With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Application.DisplayAlerts = True
Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set DestWs = Worksheets("VBANK archive")
DestLR = DestWs.Range("A" & Rows.Count).End(xlUp).Row
Crit(0) = "Arbitrage"
Crit(1) = "BDF"
Crit(2) = "CD"
Crit(3) = "CORP NIM"
Crit(4) = "Derivatives"
Crit(5) = "NIM"
Crit(6) = "VBANK EPARGNE"

With SrcWs
    .AutoFilterMode = False
    .Range("AF").Value = "Temp"
    For j = 2 To SrcLR
        StrIF = "=if(or(isnumber(search(" & Chr(34) & Crit(0) & Chr(34) & ",K" & j & ")),isnumber(search(" & Chr(34) & Crit(1) & Chr(34) _
            & ",K" & j & ")),isnumber(search(" & Chr(34) & Crit(2) & Chr(34) & ",K" & j & ")),isnumber(search(" & Chr(34) & Crit(3) & Chr(34) & ",K" & j & "))),999,0)"
        .Range("AF" & j).Formula = StrIF
    Next j
End With

Set RngFilter = SrcWs.Range("A1:AF" & SrcLR)
Set CopyRng = SrcWs.Range("A2:K" & SrcLR)
RngFilter.AutoFilter Field:=32, Criteria1:="999", Operator:=xlFilterValues
CopyRng.SpecialCells(xlCellTypeVisible).Copy
DestWs.Range("A" & DestLR + 1).PasteSpecial xlPasteValues
SrcWs.Columns(32).Delete
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
DestWs.Activate
DestWs.Columns(32).Delete
DestWs.Range("A2").Select
ActiveWindow.FreezePanes = True
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Select allOpen in new window