'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
'tester la version excel avec Int(Val(Application.Version)) si < 12 (2007)
'HDR=No signifie sans entête(header) si HDR=Yes la prem.lig n'est pas chargée !
'Vers.< 12: "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CheminFichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
'Vers.>=12: "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CheminFichier & ";Extended Properties=""Excel 12.0;HDR=No;"";"
Sub ImportUneCellOuRangDuClasseurFerme()
Dim ADOConnect As Object, ADORecord As Object, TextSQL As String
Dim FeuilSource$, RangSource$
Dim FeuilDestin$, RangDestin$
Dim NomDuClasseurSource$, CheminDuClassSource$, CheminFichSource$
'---------- init var destin pour recopie dans ce classeur --------------------------
NomDuClasseurSource = "nom du classeur avec extention" '<<<<< nom du classeur source
CheminDuClassSource = "chemin du classeur" '<<<<<<<<<<<<< chemin du classeur source
FeuilSource = "Feuil1$" '<<<<<<<<<<<< nom de la feuil.source AJOUTER LE CARACTERE $ AU BOUT
RangSource = "A2:B3" '<<<<<<<<<<<< nom du rang de données source exp "A1:A1" ou "A1:C10"
FeuilDestin = ActiveSheet.Name '<<<<< nom de la feuille de destination des données loadées
RangDestin = "A2" '<<<<<<<<<<<<<<<<<< nom de la cellule de destination (coin haut gauche)
'------------------------------------------------------------------------------------------
' lancement
If Right(CheminDuClassSource, 1) <> "\" Then CheminDuClassSource = CheminDuClassSource & "\"
CheminFichSource = CheminDuClassSource & NomDuClasseurSource
TextSQL = "SELECT * FROM [" & FeuilSource & RangSource & "]"
'ouverture (test version excel)
Set ADOConnect = CreateObject("ADODB.Connection")
If Int(Val(Application.Version)) < 12 Then
ADOConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & CheminFichSource & ";Extended Properties=""Excel 8.0;HDR=No;"";"
Else
ADOConnect.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & CheminFichSource & ";Extended Properties=""Excel 12.0;HDR=No;"";"
End If
'load les données
Set ADORecord = CreateObject("ADODB.Recordset")
Set ADORecord = ADOConnect.Execute(TextSQL)
'recopie dans ce classeur
Sheets(FeuilDestin).Range(RangDestin).CopyFromRecordset ADORecord
'fermeture connection
ADOConnect.Close
Set ADORecord = Nothing: Set ADOConnect = Nothing
End Sub