Bonjour,
à tester,
Sub test_LireCellule()
Dim Fich As String, rep As String, FeuilSource As String, Feuil_cellule_destination As String
rep = "D:\Fiches clients\"
addr = Array("C4", "C5", "C6", "C7", "F5", "F7", "I10", "I13")
Fich = Dir(rep & "*.*")
Do While Len(Fich) > 0
FeuilSource = Left(Fich, Len(Fich) - 5)
Feuil_cellule_destination = "Feuil2!A1"
LireCellule rep, Fich, FeuilSource, Feuil_cellule_destination
'traitement de données
With Sheets("DESTINATION")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 0 To 7
.Cells(lastRow, i + 1).Value = Sheets("Feuil2").Range(addr(i)).Value
Next i
End With
'fin traitement de données
Fich = Dir()
Loop
End Sub
'nécessite d'activer la référence: Microsoft ActiveX Data Objects xx Library
Function LireCellule(repertoire As String, Fichier As String, Feuille As String, dest As String)
Set cnn = New ADODB.Connection
'--- Connexion ---
With cnn
.Provider = "Microsoft.Jet.OLEDB.12.0"
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& repertoire & "\" & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
.Open
End With
'--- récupérer les données --
Set rs = cnn.Execute("SELECT * FROM [" & Feuille & "$" & cellule & "]")
Range(dest).CopyFromRecordset rs
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Function