Extraction cellules

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
Rechercher des sujets similaires à "extraction"