Sub ImportDonnées()
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim SPath As String
' Définir le répertoire source
SPath = "D:\Excel-Downloads"
' Créer l'instance FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
' Définir le dossier source de l'instance
Set SourceFolder = FSO.GetFolder(SPath)
' Pour chaque fichier contenu dans ce dossier
For Each FileItem In SourceFolder.Files
' On consolide les données
ConsoDatas FileItem.Path, "NomFeuilleSource", "NomFeuilleCible"
Next FileItem
End Sub
Public Sub ConsoDatas(NomFichier$, FeuilleSource$, FeuilleCible$)
' Va chercher dans le classeur NomFichier (sans l'ouvrir) les données
' de la feuille FeuilleSource et les copie dans la feuille FeuilleCible
' du classeur actif, à la suite des données (éventuellement) déjà présentes.
' (La ligne d'entêtes de FeuilleSource n'est pas importée)
' inspiré de Rob Bovey, mpep
' nécessite une référence à la librairie : Microsoft ActiveX Data Object 2.x Library
Dim rsData As ADODB.Recordset
Dim szConnect As String
Dim szSQL As String
Dim Li&, FeuilleDest
''' Crée la chaîne de connexion
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & NomFichier & ";" & _
"Extended Properties=Excel 8.0;"
' La requête est basée sur le nom de la feuille. Ce nom
' doit se terminer par un $ et doit être entouré de crochets droits.
szSQL = "SELECT * FROM [" & FeuilleSource & "$];"
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
'où envoyer les données :
Set FeuilleDest = ActiveWorkbook.Sheets(FeuilleCible)
Li = FeuilleDest.Range("A" & Rows.Count).End(xlUp).Row + 1
'envoi sur la première ligne vide
If Not rsData.EOF Then
FeuilleDest.Range("A" & Li).CopyFromRecordset rsData
Else
'si la source était vide...
MsgBox "Aucun enregistrement renvoyé.", vbCritical
End If
''' On nettoie pour finir...
rsData.Close
Set rsData = Nothing
End Sub
