Microsoft 365 Récupération des plages nommées des fichiers dans un répertoire

Sub Macro1()
Dim WsOutput As Worksheet
Set WsOutput = Sheets.Add(After:=Worksheets(Sheets.Count))
WsOutput.Range("A1").ListNames
End Sub

.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& oFile & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=1"""

Option Explicit
Sub testAdO()
    Dim fichier$, nomfeuille$, DispoCel As Range, plage
    fichier = "C:\Users\patricktoulon\Desktop\Classeur2.xlsm"
    nomfeuille = "feuil1"
    Set DispoCel = [A1]
    Set plage = [C2:E10]
    resADO plage, fichier, nomfeuille, DispoCel
End Sub
Function resADO(plage, fichier, nomfeuille, destination)
'patricktoulon collection fichier fermés (ADO)
    'version ado et copyfromrecordset 24/01/2013
  'Dim Cn As ADODB.Connection, texte_SQL$, Rst As ADODB.Recordset
    Dim Cn As Object, texte_SQL$, Rst As Object
      Set Cn = CreateObject("ADODB.Connection")
     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
         texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & plage.Address(0, 0) & "]"  'la requête.    ' Attention!!!!!!! à ne pas oublier le symbole "$" après le nom de la feuille.
     Set Rst = CreateObject("ADODB.RecordSet")
    Set Rst = Cn.Execute(texte_SQL)
    destination.CopyFromRecordset Rst
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing: Set Rst = Nothing
End Function

Sub testAdO_Array_Fast()
    Dim fichier$, nomfeuille$, plage As Range, DispoCel As Range
    Dim TableX As Variant
    
    fichier = "C:\Users\patricktoulon\Desktop\Classeur2.xlsm"
    nomfeuille = "feuil1"
    Set plage = [C2:E10]
    Set DispoCel = [A1]
    
    ' Récupération directe dans un tableau VBA
    TableX = resADO_GetRows(plage, fichier, nomfeuille)
    
    ' Injecter dans la feuille
    ' GetRows renvoie (Colonnes x Lignes), donc on transpose
    DispoCel.Resize(UBound(TableX, 2), UBound(TableX) + 1).Value = Application.Transpose(TableX)
End Sub

Function resADO_GetRows(plage As Range, fichier As String, nomfeuille As String) As Variant
    'patricktoulon collection fichier fermés (ADO)
    'version ado et getrow 12/07/2013
    Dim Cn As Object, Rst As Object
    Dim texte_SQL As String
    
    ' Connexion ADO
    Set Cn = CreateObject("ADODB.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"";"
    
    ' requete sur la plage exacte
    texte_SQL = "SELECT * FROM [" & nomfeuille & "$" & plage.Address(0, 0) & "]"
    
    Set Rst = CreateObject("ADODB.Recordset")
    Set Rst = Cn.Execute(texte_SQL)
    'recupération du tableau(attention c'est transposé
     If Not Rst.EOF Then
        resADO_GetRows = Rst.GetRows
    Else
        resADO_GetRows = Array()
    End If
    
    ' Fermeture
    Rst.Close
    Cn.Close
    Set Rst = Nothing
    Set Cn = Nothing
End Function

Sub test3()
   'patricktoulon
   'exemple for excel downloads 22/12/2025
   Dim Bd$, SQL, Tablo
    Bd = "C:\Users\patricktoulon\Desktop\Classeur2.xlsm"
      
      With CreateObject("ADODB.Connection")
        SQL = "select [Colonne1],[Colonne2],[Colonne3] from [Feuil1$]"
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Bd & ";Extended Properties='Excel 12.0;HDR=Yes'"
        Tablo = .Execute(SQL).GetRows
        .Close
          [A1].Resize(UBound(Tablo, 2), UBound(Tablo) + 1).Value = Application.Transpose(Tablo)

    End With
End Sub

Option Explicit
Sub test2()
'pour une plage classique
    Dim chemin$, fichier$, feuille$, rngsource As Range, rngdestination As Range
    chemin = "C:\Users\patricktoulon\Desktop\"  'ne pas oublier le dernier slach
    fichier = "Classeur2.xlsm"
    feuille = "Feuil1"
    Set rngsource = [C2:E10]
    Set rngdestination = Sheets("Feuil1").[A1]
    GetTableOnClosedFich2 chemin, fichier, feuille, rngsource, rngdestination

End Sub



Sub GetTableOnClosedFich2(chemin$, fichier$, feuille$, rng As Object, rngD As Range)
    'Collection fichier fermés patricktoulon
    'utilisation d'une macro4 en boucle pour charger un variant
    Dim tabl, lig&, col&
    ReDim tabl(1 To rng.Rows.Count, 1 To rng.Columns.Count)
    For lig = 1 To UBound(tabl)
        For col = 1 To UBound(tabl, 2)
            tabl(lig, col) = ExecuteExcel4Macro("'" & chemin & "[" & fichier & "]" & feuille & "'!" & rng.Cells(lig, col).Address(, , xlR1C1))
        Next
    Next
    Application.ScreenUpdating = False
    rngD.Resize(rng.Rows.Count, rng.Columns.Count).Value = tabl
    Application.ScreenUpdating = True
End Sub