Option Explicit
Sub test()
Dim Source As ADODB.Connection, Rst As ADODB.Recordset, i As Integer
Dim ADOCommand As ADODB.Command, fichier As String, Cellule As String, Feuille As String
Cellule = "A1:T500" 'plage de cellules
Feuille = "Feuil1$" 'nom feuille suivi d'un $
fichier = ThisWorkbook.Path & "\ClasseurSource " & Sheets("Destination").ComboBox1.Value & ".xls"
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fichier & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Cellule & "]"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Cellule & "]")
With Sheets("Résultat attendu").Range("A65536").End(xlUp)
.Offset(2, 0).Value = Sheets("Destination").ComboBox1.Value
For i = 0 To Rst.Fields.Count - 1
.Offset(3, i).Value = Rst.Fields(i).Name
Next i
.Offset(4, 0).CopyFromRecordset Rst
End With
Rst.Close
Source.Close
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
End Sub