XL 2013 RESOLU - MACRO Copier/Coller les cellules d'une ligne en fonction d'un critère

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim plage As Range, plg As Range, pg As Range, x&

    Cancel = True

    Application.ScreenUpdating = False
    x = Range("c" & Rows.Count).End(xlUp).Row

    Set plage = Range("a11:r" & x)  'Ici Entêtes Colonnes
    plage.AutoFilter Field:=18, Criteria1:="No", Operator:=xlAnd

    Set plg = Range("a12:r" & x)
    Set pg = Union(Range("c12:k" & x), Range("n12:o" & x), Range("r12:r" & x))

    plg.Cells.SpecialCells(xlCellTypeVisible).Copy Sheets("Archive Project").Range("c" & Rows.Count).End(xlUp)(2)
    pg.Cells.SpecialCells(xlCellTypeVisible).ClearContents

    plage.AutoFilter
End Sub

Option Explicit

Sub Copier_Tableau_A_La_Suite()
Dim plage As Range, plg As Range, tbl, tablo()
Dim wb As Worksheet, wm As Worksheet
Dim lig&, col&, fin&, i&, j&, k&, x&

    Set wb = Sheets("Project"): Set wm = Sheets("Archive Project")
    Set plage = wb.Range("c12:r" & wb.Range("c800000").End(xlUp).Row)

    lig = plage.Rows.Count: col = plage.Columns.Count: k = 0
    tbl = plage.Value: ReDim tablo(1 To UBound(tbl), 1 To col)

    For i = LBound(tbl) To UBound(tbl)
        If tbl(i, 16) = "Yes" Or tbl(i, 16) = "No" Or tbl(i, 16) = "Ok" Then
            k = k + 1
            For j = 1 To col
                tablo(k, j) = tbl(i, j)
            Next j
        End If
    Next i
    wm.Range("c" & Rows.Count).End(xlUp)(2).Resize(lig, col) = tablo

    With wb
       fin = .Cells(Rows.Count, 13).End(xlUp).Row
        For x = 12 To fin
            If .Cells(x, 18) = "Yes" Or .Cells(x, 18) = "No" Or .Cells(x, 18) = "Ok" Then
               .Range(.Cells(x, 3), .Cells(x, 11)).ClearContents
               .Range(.Cells(x, 14), .Cells(x, 15)).ClearContents
               .Cells(x, 18).ClearContents
            End If
        Next x
    End With
End Sub