XL 2021 Problème d'accès aux datas d'une autre feuille fermée

Option Explicit

' ======
' EN FAIRE UNE CLASSE! Plus cool
' Avec fonction de concatenation "automatique" des tableaux
Type Result_Type
    Value() As Variant
    Address() As String
    LeType() As Variant
End Type

Dim Tablo() As Result_Type
' ======

Sub Test_récup_plage()
    Dim I, J, K
    Dim Fichier$, Item
    Dim MyRge
    Set MyRge = Range("C1:C3,C5:C6")
    ReDim Tablo(1 To MyRge.Areas.Count)
    ReDim T(1 To MyRge.Areas.Count)
    Fichier = "E:\FONCTIONS VBA PERSO\TESTS\Datas externes.xlsx"     'à adapter
'  NOTE! Le passage d'adresses préfixées $Ligne$Colon ne marche pas.
    For Each Item In MyRge.Areas
      I = I + 1
      ReDim Tablo(I).Address(1 To Item.Rows.Count, 1 To Item.Columns.Count)
'    Sauve les adresses
      For J = 1 To Item.Rows.Count
        For K = 1 To Item.Columns.Count
          Tablo(I).Address(J, K) = Item.Cells(J, K).Address(False, False)
        Next K
      Next J
      ReDim Tablo(I).Value(1 To Item.Rows.Count, 1 To Item.Columns.Count)
      ReDim Tablo(I).LeType(1 To Item.Rows.Count, 1 To Item.Columns.Count)
      T(I) = GetUserRangeOnClosedFich2(I, Fichier, Item.Address(False, False), "Feuil1", False)
    Next Item

'    [A1].Resize(UBound(T), UBound(T, 2)) = T

    For I = 1 To UBound(Tablo)
      For J = 1 To UBound(Tablo(I).Value)
        For K = 1 To UBound(Tablo(I).Value, 2)
          Debug.Print "Valeur: ", Tablo(I).Value(J, K)
          Debug.Print "Adresse: ", Tablo(I).Address(J, K)
          Debug.Print "Type: ", Tablo(I).LeType(J, K)
        Next K
      Next J
      Debug.Print "========"
    Next I
End Sub

'renvoie les valeurs d'une plage de cellules contigües (RnG)
'd'une feuille (Feuille) d'un fichier (fichier) fermé
'le paramètre headerTable indique si la plage a ou non une ligne d'entêtes
Function GetUserRangeOnClosedFich2(ByVal Index As Integer, Fichier As String, RnG As String, Optional Feuille As String = "", Optional headerTable As Boolean = False)
    Dim HDR As String, RsTLigne As Integer, RsTCol As Integer
    'Early Binding
    'Dim AdConn As ADODB.Connection, AdoComand As ADODB.Command, RsT As ADODB.Recordset
    'Set AdConn = New ADODB.Connection
    'Set RsT = New ADODB.Recordset
    'Set AdoComand = New ADODB.Command

    'late Binding
    Dim AdConn As Object, AdoComand As Object, RsT As Object
    Set AdConn = CreateObject("ADODB.Connection")
    Set AdoComand = CreateObject("ADODB.Command")
    Set RsT = CreateObject("ADODB.Recordset")

    HDR = Array("No", "Yes")(Abs(headerTable))

   AdConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Fichier & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1;"""
    AdoComand.ActiveConnection = AdConn
    If Feuille = "" _
       Then AdoComand.CommandText = "SELECT * from `" & RnG & "`" _
       Else AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    RsT.Open AdoComand, , 1, 1
    ReDim Arr(1 To RsT.RecordCount, 1 To RsT.Fields.Count)
    RsT.MoveFirst
    Do While Not RsT.EOF
        For RsTLigne = 1 To RsT.RecordCount  'lignes
            For RsTCol = 0 To RsT.Fields.Count - 1  'colonnes
                Arr(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Value
                Tablo(Index).Value(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Value
                Tablo(Index).LeType(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Type
            Next
            RsT.MoveNext
        Next
    Loop
    AdConn.Close
    Set RsT = Nothing
    Set AdoComand = Nothing
    Set AdConn = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2]) Is Nothing Then Exit Sub
Dim chemin$, fichier$, feuille$, form$, a As Range, f$
If TypeName(Evaluate([E2].Text)) <> "Range" Then [E2] = "C1"
chemin = ThisWorkbook.Path & "\"
fichier = "Datas externes.xlsx"
feuille = "Feuil1"
form = "'" & chemin & "[" & fichier & "]" & feuille & "'!"
For Each a In Range([E2]).Areas
    f = f & "," & form & a.Address 'concatène les formules
Next
[E4] = "=SUM(" & Mid(f, 2) & ")" 'cellule Résultat
End Sub

'Option Explicit

Function Total(Cellule As Range) As Variant
  Total = WorksheetFunction.Sum(Cellule)
End Function

Sub test_récup_plage()
    Dim fichier$, T
    fichier = ThisWorkbook.Path & "\Datas externes.xlsx"    'à adapter
    T = GetUserRangeOnClosedFich2(fichier, "C1;C3", "Feuil1", False)
    [A1].Resize(UBound(T), UBound(T, 2)) = T
End Sub

'renvoie les valeurs d'une plage de cellules contigües (RnG)
'd'une feuille (Feuille) d'un fichier (fichier) fermé
'le paramètre headerTable indique si la plage a ou non une ligne d'entêtes
Function GetUserRangeOnClosedFich2(fichier As String, RnG As String, Optional Feuille As String = "", Optional headerTable As Boolean = False)
    Dim HDR As String, RsTLigne As Integer, RsTCol As Integer
    'early binding
    'Dim AdConn As ADODB.Connection, AdoComand As ADODB.Command, RsT As ADODB.Recordset
    'Set AdConn = New ADODB.Connection
    'Set RsT = New ADODB.Recordset
    'Set AdoComand = New ADODB.Command

    'late binding
    Dim AdConn As String, RsT As Object ', AdoComand As Object
'    Set AdConn = CreateObject("ADODB.Connection")
'    Set AdoComand = CreateObject("ADODB.Command")
    Set RsT = CreateObject("ADODB.Recordset")

    HDR = Array("No", "Yes")(Abs(headerTable))

   AdConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1;"""
   Dim SQL As String
    If Feuille = "" Then
        SQL = "SELECT * from `" & RnG & "`"
       Else
     
            For Each g In Split(RnG & ";", ";")
                If g <> "" Then
                    If SQL <> "" Then SQL = SQL & " Union All"
                     SQL = SQL & " SELECT * from [" & Feuille & "$" & g & ":" & g & "]"
                End If
               
       
         Next
       End If
     RsT.Open SQL, AdConn, 1, 1
    ReDim Arr(1 To RsT.RecordCount, 1 To RsT.Fields.Count)
    RsT.MoveFirst
    Do While Not RsT.EOF
        For RsTLigne = 1 To RsT.RecordCount  'lignes
            For RsTCol = 0 To RsT.Fields.Count - 1  'colonnes
                Arr(RsTLigne, RsTCol + 1) = RsT.Fields(RsTCol).Value
            Next
            RsT.MoveNext
        Next
    Loop
Rst.close : Set RsT = Nothing ': Set 'AdoComand = Nothing: Set AdConn = Nothing
    GetUserRangeOnClosedFich2 = Arr
End Function

For Each a In Union(Range([E2]), Range([E2])).Areas