Variable Tableau : récupérer une plage multiple

Sub toto()
Dim der&, i&, tab1, tab2, t0
  t0 = Timer: der = Cells(Rows.Count, "a").End(xlUp).Row
  tab1 = Range("a4:b" & der).Value: tab2 = Range("f4:f" & der).Value
  der = UBound(tab1): ReDim Preserve tab1(1 To der, 1 To 3)
  For i = 1 To der: tab1(i, 3) = tab2(i, 1): Next i
  Erase tab2: t0 = Timer - t0: MsgBox Format(t0, "#,##0.0")
End Sub

Rem. —— Chargement des paramètres en Tableau. Plages multizones et tableaux de variants supportés. Ces fonctions sont concues pour mettre en un tableau
'       unique de Variant des valeurs de plages exactement comme le fait DictionnArbo mais pour d'autres usages, ou non, depuis VBA, à partir
'       de paramètres à analyser soit spécifiés par la procédure appelante soit simplement transmis par elle selon un ParamArray récupéré.
Public Sub CréerTabSpécif(TabRésu() As Variant, ParamArray Param() As Variant):  CréerTableau TabRésu, Param: End Sub
Public Sub CréerTabDicoSpécif(ParamArray Param() As Variant):                    CréerTableau TabDico, Param: End Sub
Public Sub CréerTabDico(ByVal Param As Variant):                                 CréerTableau TabDico, Param: End Sub
Public Function TabSpéc(ByVal Param As Variant) As Variant():                    CréerTableau TabSpéc, Param: End Function
Public Sub CréerTableau(TabRésu() As Variant, ByVal Param As Variant)
Dim P As Long, Z As Long, VZon() As Variant, C As Long, CFnA As Long
LMax = 0
For P = 0 To UBound(Param)
   If TypeName(Param(P)) = "Range" Then
      For Z = 1 To Param(P).Areas.Count
         If LMax = 0 Then
            TabRésu = Param(P).Areas(1).Value: LMax = UBound(TabRésu, 1): CMax = UBound(TabRésu, 2)
         Else
            VZon = Param(P).Areas(Z).Value
            If UBound(VZon, 1) <> LMax Then MsgBox "Paramètre " & P & ", zone " & Z & ": " & UBound(VZon, 1) & " lignes au lieu de " & LMax _
               & vbLf & "==> Débogage obligatoire", vbCritical, "Fabriquer tableau": Stop: Exit Sub ' Déroulez en pas à pas
            ReDim Preserve TabRésu(1 To LMax, 1 To CMax + UBound(VZon, 2)) As Variant
            For C = 1 To UBound(VZon, 2)
               CMax = CMax + 1
               For L = 1 To LMax: TabRésu(L, CMax) = VZon(L, C): Next L
               Next C
            End If
         Next Z
   ElseIf Not IsArray(Param(P)) Then
      On Error Resume Next: CFnA = Param(P): If Err Then CFnA = CMax
      On Error GoTo 0
   ElseIf LMax = 0 Then
      TabRésu = Param(P): LMax = UBound(TabRésu, 1): CMax = UBound(TabRésu, 2)
   ElseIf UBound(Param(P), 1) <> LMax Then
      MsgBox "Paramètre " & P & ": " & UBound(Param(P), 1) & " lignes au lieu de " & LMax _
         & vbLf & "==> Débogage obligatoire", vbCritical, "Fabriquer tableau": Stop: Exit Sub ' Déroulez en pas à pas
   Else
      ReDim Preserve TabRésu(1 To LMax, 1 To CMax + UBound(Param(P), 2)) As Variant
      For C = 1 To UBound(Param(P), 2)
         CMax = CMax + 1
         For L = 1 To LMax: TabRésu(L, CMax) = Param(P)(L, C): Next L
         Next C
      End If
   Next P
If CFnA <> 0 Then CMax = CFnA
End Sub

tablox = Range("a4:f" & der)

Sub test3()
    Dim shTmp As Worksheet, datas
    Application.ScreenUpdating = False
    Intersect([A1].CurrentRegion.EntireRow, Range("A:A,B:B,E:E")).Copy
    Set shTmp = Sheets.Add
    shTmp.[A1].PasteSpecial Paste:=xlPasteValues
    datas = shTmp.[A1].CurrentRegion
    Application.DisplayAlerts = False
    shTmp.Delete
    Application.DisplayAlerts = True
End Sub

Sub Array_Colonnes()
Dim x, i As Byte
    x = Split(InputBox(prompt:="Saisir les numéros de colonnes"), ",")
    For i = LBound(x) To UBound(x)
        MsgBox x(i)
    Next i
End Sub

Sub FiltreColonnes()
    a = [A4:F10].Value
    x = Split(InputBox(prompt:="Saisir les numéros de colonnes"), ",")
    b = FiltreArrayCol(a, x)    ' on prend les colonnes 1, 2,6
    [m1].Resize(UBound(b), UBound(b, 2)) = b
End Sub

Function FiltreArrayCol(tableau, ColResult)
  Dim b()
  ReDim b(LBound(tableau) To UBound(tableau), 1 To UBound(ColResult) + 1 - LBound(ColResult))
  For i = LBound(tableau, 1) To UBound(tableau, 1)
    For c = LBound(ColResult) To UBound(ColResult)
      col = ColResult(c)
      b(i, c + 1) = tableau(i, col)
    Next c
  Next i
  FiltreArrayCol = b
End Function

Sub FiltreColonnes()
    a = [A4:F10].Value
    txt = "1,2,6"
    x = Evaluate("{" & txt & "}")
    'x = Array(1, 2, 6)
    'b = FiltreArrayCol(a, Array(1, 2, 6))    ' on prend les colonnes 1, 2,6
    b = FiltreArrayCol(a, x)    ' on prend les colonnes 1, 2,6
    [m1].Resize(UBound(b), UBound(b, 2)) = b
End Sub

Function FiltreArrayCol(tableau, ColResult)
  Dim b()
  ReDim b(LBound(tableau) To UBound(tableau), 1 To UBound(ColResult) - LBound(ColResult) + 1)
  For i = LBound(tableau, 1) To UBound(tableau, 1)
    For c = LBound(ColResult) To UBound(ColResult)
      col = ColResult(c)
      b(i, c) = tableau(i, col)
    Next c
  Next i
  FiltreArrayCol = b
End Function

a = 4
b = 2
c = 5

TabCol = Split(a & " " & b & " " & c)
....
...
tablox = Application.Index(.Value, Evaluate("row(1:" & der & ")"), TabCol)
...