XL 2016 Problème avec array

Sub testPatricktoulon()
    Dim Bd, arr, col&, ligne2&, x&
    ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path
    Bd = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", , "Selectionnez un  classeur source")    'dialog fichier

    If Bd = False Then MsgBox " operation de récupération annulée": Exit Sub    'on sort si on annule dans le dialog

    'valeur recherchée dans la colonne 12 du tableau structuré du fichier fermé
    arr = Array(3200000, 3000001, 3200020, 3200100, 3200110, 3200120, 3210000, 3212000, 3212010, 3212100, 3212110, 3212120, 3212200, 3212210, 3212220, 3212300, 3212310, 3212320, 3212400, 3212410, 3212420, 3212430, 3220000, 3220010, 3221000, 3221100, 3221110, 3221120, 3221200, 3221210, 3221220, 3222000, 3222100, 3222110, 3222120, 3222130, 3222200, 3222210, 3222220)


    With CreateObject("ADODB.Connection")    'on créée l'object ADODB.connection( en annonyme il sera detruit en sortie de end sub)
        Sql = "select [CDPOSTE],[DATE_DEBUT],[HEURE_DEBUT] from [Feuil1$]"    'l'argument de requete connerne certaines colonnes
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Bd & ";Extended Properties='Excel 12.0;HDR=Yes'"    'on ouvre adobd.connection
        tablo = .Execute(Sql).GetRows    ' on lui sinifie la requete et tablo prend les valeur des colonnes désirées
        .Close    'on ferme adobd.connection

        'on a maintenant un tableau de 3 lignes sur X colonnes

        ' on redim une nouvelle variable tableau  a l'inverse (x lignes et 3 colonnes)
        ReDim tablo2(1 To UBound(tablo, 2), 1 To 3)    'on redim notre tablo2 de destination direct sans transposer !!!!!!!

        For col = 0 To UBound(tablo, 2)    'on boucle sur les colonne du tablo issue de la requete

            x = Application.IfError(Application.Match(tablo(0, col), arr, 0), 0)    'test presence dans l'array de la valeur de la ligne 0  et colonne X de "tablo" (anciennement colonne 12 du tableau structuré)
           ' Debug.Print tablo(0, 20) & "--->" & x    ' juste pour controler que le match (positif ou negatif )seproduit bien
            If x > 0 Then    ' si presence on l'insert dans le tablo2 (les 3 valeur  mais transposées)
                ligne2 = ligne2 + 1
                tablo2(ligne2, 1) = tablo(0, col)
                tablo2(ligne2, 2) = tablo(1, col)
                tablo2(ligne2, 3) = tablo(2, col)
            End If

        Next
        'voila maintenant on a un tableau avec uniquement les valeurs désirée  de la colonne 12 du tableau structuré soit la colonne 0 due tablo
        ActiveSheet.[A1].Resize(, 3) = Array("CDPOSTE", "DATE_DEBUT", "HEURE_DEBUT")    'on met les entetes (facultatif)
        ' maintenant on resize A2 non pas au ubound du tablo2 mais ligne2 qui a été incrémenté tout au long de la boucle et sur 3 colonnes
        ActiveSheet.[A2].Resize(ligne2, 3) = tablo2
        'terminé pastis et saucisson c'est l'heure
    End With
End Sub

  vDat1 = Rst1.GetRows
'--- Fermeture connexion 1 ---
    Set Rst1 = Nothing
    Cn1.Close
    Set Cn1 = Nothing
    x = 0
'Dim vDat2(3, 1)
    For i = 1 To UBound(vDat1, 2)
        For j = 1 To UBound(arr, 1)
        If vDat1(12, i) = arr(j) Then
        x = x + 1
        ReDim Preserve vDat2(1 To 3, 1 To x)
        vDat2(1, x) = vDat1(12, i)
        vDat2(2, x) = vDat1(4, i)
        vDat2(3, x) = vDat1(7, i)
        End If
        Next

Sub test_Array()
Dim varArray() As Variant
Dim i, j As Integer
Dim lrows As Long
Dim lcols As Long: Dim rng As Range
Range("a1:af120").ClearContents
lrows = Int((8 - 4 + 1) * Rnd + 4)
lcols = Int((6 * Rnd) + 1)
i = 0: j = 0
ReDim Preserve varArray(1 To lcols, 1 To lrows)
For i = 1 To lrows
    For j = 1 To lcols
    varArray(j, i) = i * j
    Cells(i, j + 9) = i * j
    Next
Next
For i = 1 To UBound(varArray, 2) ' - 1
For j = 1 To UBound(varArray, 1) ' - 1
Cells(i, j) = varArray(j, i)
Next
Next
Dim outputArr As Variant
outputArr = TransposeArray(varArray)
Set rng = Range(Cells(1, 1), Cells(lrows, lcols))
   rng = outputArr
End Sub
Function TransposeArray(MyArray As Variant) As Variant
    Dim x As Long, y As Long
    Dim maxX As Long, minX As Long
    Dim maxY As Long, minY As Long
    Dim tempArr As Variant
    'Get Upper and Lower Bounds
    maxX = UBound(MyArray, 1)
    minX = LBound(MyArray, 1)
    maxY = UBound(MyArray, 2)
    minY = LBound(MyArray, 2)
    
    'Create New Temp Array
    ReDim tempArr(minY To maxY, minX To maxX)
    'Transpose the Array
    For x = minX To maxX
        For y = minY To maxY
            tempArr(y, x) = MyArray(x, y)
        Next y
    Next x
    'Output Array
    TransposeArray = tempArr
    
End Function

outputArr = application.transpose(varArray)

Sub test_Array()
    Dim varArray(), i&, j&, lrows&, lcols&, rng As Range, outputArr
    Range("a1:af120").ClearContents
    lrows = Int((8 - 4 + 1) * Rnd + 4)
    lcols = Int((6 * Rnd) + 1)
    i = 0: j = 0
    ReDim Preserve varArray(1 To lcols, 1 To lrows) 'on dimentionne la variable  tableau
    'on alimente le tableau
    Randomize
    For i = 1 To lrows
        For j = 1 To lcols
            varArray(j, i) = Round(Rnd * 2000) 'avec des chiffre au hasard
        Next
    Next
       'on injecte la variable tableau dans la plage dimentionnée identiquement a la variable tableau
        Cells(1, 9).Resize(UBound(varArray), UBound(varArray, 2)) = varArray 'on injecte le tableau en un coup

     outputArr = TransposeArray(varArray) 'appel de la fonction de transposition
    'on dimentionne une plage a la dimention du tableau transposé
    Set rng = Cells(1, "A").Resize(UBound(outputArr), UBound(outputArr, 2)) '
    rng = outputArr 'on injecte la variable tableau transposée dans la plage
End Sub

Function TransposeArray(MyArray As Variant) As Variant
    Dim Col&, Lig&, Arr
     'dimentionnement de la variable tableau identiquement transposée
   ReDim Arr(LBound(MyArray) To UBound(MyArray, 2), LBound(MyArray) To UBound(MyArray))
    'on alimente la nouvelle variable tableau (ligne devient colonne et colonne devient ligne
    For Col = LBound(MyArray) To UBound(MyArray, 2)
        For Lig = LBound(MyArray) To UBound(MyArray)
            Arr(Col, Lig) = MyArray(Lig, Col)
        Next
    Next
    TransposeArray = Arr 'return
End Function