Extraction cellules
f
Salut à tous,
Je suis nouveau dans le forum et je ne sais ci c'est le bon endroit de déposer mon problème.
En fait, je possède plusieurs fichiers excel (base de donnée) je souhaite extraire des cellules de chaque fichier vers une seule feuille.
La sélection de la cellule à extraire se fait selon l'intersection des colonne et ligne spécifique à deux cellules.
j’espère que j'ai pu décrire la situation, donc je voudrais savoir comment ça ce fait ?
Merci d'avance
Bonjour,
voici un exemple, (il faut adapter)
Sub test()
Dim Fich As String, rep As String, FeuilSource As String, Feuil_cellule_destination As String
rep = "C:\Users\isabelle\Documents\Test3\" 'à adapter
Fich = Dir(rep & "*.xls*")
Do While Len(Fich) > 0
FeuilSource = "Feuil1" 'à adapter
Feuil_cellule_destination = "Feuil1!A" & Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row + 1 'à adapter
LireCellule rep, Fich, FeuilSource, Feuil_cellule_destination
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 & "$" & Range("C4:C5").Address(0, 0) & "]")
Range(dest).CopyFromRecordset rs
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
End Function