XL 2016 Méthode rapide pour mettre cellules dans variable tableau

Sub Macro2()
T = Timer
Dim Plg As Range
With Sheets("DA")
    Set Plg = .Range("A4:Q" & .Cells(Rows.Count, "F").End(xlUp).Row)
    .Range("S5").FormulaR1C1 = "=RC[-11]<>0"
End With
With Sheets("Résultat")
    .Range("K1").Resize(, 4).Value = Sheets("DA").Range("E4").Resize(, 4).Value
    Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("DA").Range("S4:S5"), CopyToRange:=.Range("K1").Resize(, 4), Unique:=False
End With
Sheets("DA").Range("S4:S5").Clear
MsgBox Timer - T
End Sub

Sub Essai()
Dim deb, der&, t, i&, n&, j&
   deb = Timer: Application.ScreenUpdating = False
   With Sheets("DA")
      der = .Cells(.Rows.Count, "e").End(xlUp).Row
      t = .Range("e5:h" & der)
   End With
   For i = 1 To UBound(t)
      If IsNumeric(t(i, 4)) Then If t(i, 4) > 0 Then n = n + 1
   Next i
   ReDim r(1 To n, 1 To 4): n = 0
   For i = 1 To UBound(t)
      If IsNumeric(t(i, 4)) Then
         If t(i, 4) > 0 Then n = n + 1: For j = 1 To 4: r(n, j) = t(i, j): Next
      End If
   Next i
   MsgBox "Durée construction du tableau résultat r = " & Format(Timer - deb, "0.000\ sec.")
   'vérif
   Sheets("résultat").Columns("a:d").Clear
   Sheets("résultat").Columns("a:d").Resize(UBound(r)) = r
End Sub

Option Explicit
Sub Test4()
Dim deb As Single
deb = Timer
Application.ScreenUpdating = True
  Dim ShtDA As Worksheet
      Set ShtDA = ThisWorkbook.Worksheets("DA") ' ..................... Feuille DA
  Dim dLig As Long
      dLig = ShtDA.Range("F" & Rows.Count).End(xlUp).Row ' ............ Derniére ligne non vide
  Dim Filtre As Range
      Set Filtre = ShtDA.Range(ShtDA.Cells(4, 5), ShtDA.Cells(dLig, 8)) ' .. Zone de séléction pour Filtre
          Filtre.AutoFilter Field:=4, Criteria1:="<>" ' .............. Filtre sur Place
  Dim Plage As Range
      Set Plage = Filtre.SpecialCells(xlCellTypeVisible) ' .......... Cellule visible de la zone de Filtre
                  Filtre.AutoFilter ' ............................... Suppression du filtre
  Dim ShtResult As Worksheet
      Set ShtResult = Worksheets("Résultat")
  Dim t() As Variant
  Dim i As Long
  ReDim t(1 To Plage.Areas.Count)
        For i = LBound(t) To UBound(t)
            t(i) = Plage.Areas(i).Value
            ShtResult.Cells(i, 1).Resize(UBound(t(i), 1), UBound(t(i), 2)) = t(i)
        Next i
Application.ScreenUpdating = False
MsgBox "Durée construction du tableau résultat r = " & Format(Timer - deb, "0.000\ sec.")
End Sub

Option Explicit
Sub Test7()
Dim deb As Single
deb = Timer
Application.ScreenUpdating = False
  Dim ShtDA As Worksheet
      Set ShtDA = ThisWorkbook.Worksheets("DA") ' ..................... Feuille DA
  Dim dLig As Long
      dLig = ShtDA.Range("F" & Rows.Count).End(xlUp).Row ' ............ Derniére ligne non vide
  Dim Filtre As Range
      Set Filtre = ShtDA.Range(ShtDA.Cells(4, 5), ShtDA.Cells(dLig, 8)) ' .. Zone de séléction pour Filtre
          Filtre.AutoFilter Field:=4, Criteria1:="<>" ' .............. Filtre sur Place
  Dim Plage As Range
      Set Plage = Filtre.SpecialCells(xlCellTypeVisible) ' .......... Cellule visible de la zone de Filtre
                  Filtre.AutoFilter ' ............................... Suppression du filtre
  Dim ShtResult As Worksheet
      Set ShtResult = Worksheets("Résultat")
  Dim t(), temp() As Variant
  ReDim temp(1 To Plage.Areas.Count, 1 To Plage.Areas(1).Count)
  Dim i, j As Long
  ReDim t(1 To Plage.Areas.Count)
        For i = LBound(t) To UBound(t)
            t(i) = Plage.Areas(i).Value
                For j = LBound(temp, 2) To UBound(temp, 2)
                    temp(i, j) = t(i)(1, j)
                    'temp(i, j) = Plage.Areas(i)(1, j)
                Next j
        Next i
        ShtResult.Cells(1, 1).Resize(UBound(temp, 1), UBound(temp, 2)) = temp
Application.ScreenUpdating = True
MsgBox "Durée construction du tableau résultat r = " & Format(Timer - deb, "0.000\ sec.")
End Sub