Bonjour,
Je vous propose une petite procédure qui importe le résultat d'une requête faite sur une base de données Access dans une feuille Excel.
Cette requête est exécutée par une fonction nommée QueryAccess qui renvoie une table contenant le résultat d'une requête faite sur une base de données Access.

Référencement
Pour faire fonctionner la fonction, il est nécessaire de référencer Microsoft DAO 3.6 ObjectLibrary. Dans l'éditeur VBA Outils/Références...
Base de données
La base de données utilisée est Comptoir.mdb livrée avec Access.
Les variables servant au test
Query - Contient la requête SQL.
db - Nom du fichier contenant la base de données précédé du chemin complet
En production, ces deux variables sont placées dans une cellule mais pour une meilleure compréhension du code, j'ai utilisé des constantes.
shtExport - CodeName de la feuille Excel où a lieu l'exportation du résultat de la requête sur la base de données Access
Les arguments de la fonction
dbFullName de type String, contient le chemin complet + le nom de la base de données.
SqlQuery de type String, contient la requête SQL.
En-tête de module
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
Option Explicit
Const Query As String = "SELECT Clients.Société, Clients.Fonction, Clients.Ville, Clients.Région FROM Clients;"
Const db As String = "Z:\Test\_mso Vba - Access\DataBase\Comptoir.mdb"
La fonction QueryAccess
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Function QueryAccess(dbFullName As String, SqlQuery As String)
 ' Nécessite de référencer Microsoft DAO x.x ObjectLibrary
 ' Arguments
 ' dbFullName ' Chemin +  nom du fichier
 ' SqlQuery ' Chaîne de caractère contenant la requête SQL
 '  Variables - Déclaration et affectation des valeurs
 Dim db As DAO.Database, Rs As DAO.Recordset
 Dim myTable(), count As Long, Elem As Integer
 Set db = Workspaces(0).OpenDatabase(dbFullName, ReadOnly:=True)
 Set Rs = db.OpenRecordset(SqlQuery)
 ' Lecture des enregistrements de la requête
 While Not Rs.EOF
  ReDim Preserve myTable(Rs.Fields.count, count)
  For Elem = 0 To Rs.Fields.count - 1
   If count = 0 Then
     myTable(Elem, count) = Rs(Elem).SourceField ' Etiquettes de colonnes
    Else
     myTable(Elem, count) = IIf(IsNull(Rs(Elem)), "", Rs(Elem))
   End If
  Next Elem
  count = count + 1: Rs.MoveNext
 Wend
 QueryAccess = Application.WorksheetFunction.Transpose(myTable)
 Rs.Close: db.Close: Set Rs = Nothing
End Function
La procédure de test
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
Sub TestQuery()
 Dim myTable(), dbExport As Range
 ' Dim db As String, Query As String
 ' db = shtParam.Range("pDataBase")
 ' Query = shtSql.Range("B3")
 myTable = QueryAccess(db, Query)
 With shtExport
  Set dbExport = .Range("A1", .Cells(UBound(myTable, 1), UBound(myTable, 2)))
 End With
 dbExport = myTable
End Sub