Private Sub ConnecterClasseur(ConnectCL As Object, _
                              Classeur As String, _
                              Optional Rs)
    Set ConnectCL = CreateObject("ADODB.Connection")
    
    If Not IsMissing(Rs) Then
    
        Set Rs = CreateObject("ADODB.Recordset")
        
    End If
    
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & Classeur & ";" & _
                   "Extended Properties=""Excel 8.0;HDR=NO;IMEX=2;"""
End Sub
Private Sub ConnecterBase(ConnectBD As Object, _
                          FichierBase As String, _
                          Optional Rs)
    Set ConnectBD = CreateObject("ADODB.Connection")
    
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
    
    With ConnectBD
    
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        
        .ConnectionString = FichierBase
        .Open
        
    End With
End Sub
Private Sub Importer()
    Dim ConnectClasseur As Object
    Dim ConnectBase As Object
    Dim Rs As Object
    Dim Base As String
    Dim Classeur As String
    Dim NomFeuille As String
    Dim SQL As String
    
    SQL = "SELECT T1.PATNUM, T1.PATNOMP, T1.PATCONF, T2.VMDD FROM T1, T2 WHERE " & _
    "T1.PATNUM=T2.PATNUM AND T2.VMDD BETWEEN #" & Format([F1], "yyyy/mm/dd") & "# AND #" & Format([F2], "yyyy/mm/dd") & "#;"
    
    Base = "D:\Base de données1.mdb"
    Classeur = "D:\Classeur2.xls"
    
    NomFeuille = "Feuil1"
    
    ConnecterBase ConnectBase, Base, Rs
    ConnecterClasseur ConnectClasseur, Classeur
    
    With Rs
    
        .CursorType = 1
        .LockType = 3
        .Open SQL, ConnectBase
        Worksheets(NomFeuille).[A1].CopyFromRecordset Rs
        
    End With
    
    ConnectBase.Close
    ConnectClasseur.Close
    
    Set ConnectBase = Nothing
    Set ConnectClasseur = Nothing
    Set Rs = Nothing
End Sub