VBA If statement with filtered values

Sub CopyFilteredRow()
Dim SrcWs As Worksheet, DestSh As Worksheet
Dim SrcLR As Long
Dim CritRng As Range
Dim InBnd As String, OutBnd As String
Dim c As Range, ar As Range
Dim DestRow As Long
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set SrcWs = Worksheets("Table1")
Set DestSh = Worksheets("Main")
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
DestSh.Range("A4:G100").ClearContents
DestSh.Range("A1").ClearContents
SrcWs.Range("B2", SrcWs.Cells(SrcWs.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Copy
DestSh.Range("A1").PasteSpecial xlPasteValues
InBnd = "INBOUND"
OutBnd = "OUTBOUND"
DestRow = 4
Set CritRng = SrcWs.Range("N2:N" & SrcLR).SpecialCells(xlCellTypeVisible)
For Each ar In CritRng.Areas
    For Each c In ar
        If c.Value = InBnd Then
            SrcWs.Range("A" & c.Row).Copy
            DestSh.Range("A" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("C" & c.Row).Copy
            DestSh.Range("B" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("F" & c.Row).Copy
            DestSh.Range("C" & DestRow).PasteSpecial xlPasteValues
            DestRow = DestRow + 1
        ElseIf c.Value = OutBnd Then
            SrcWs.Range("A" & c.Row).Copy
            DestSh.Range("E" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("C" & c.Row).Copy
            DestSh.Range("F" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("F" & c.Row).Copy
            DestSh.Range("G" & DestRow).PasteSpecial xlPasteValues
            DestRow = DestRow + 1
        End If
    Next c
Next ar

Application.CutCopyMode = False
DestSh.Activate
DestSh.Columns.AutoFit
DestSh.Range("A4").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