Importation de données de plusieurs classeurs dans un classeur destination

Bonjour,

J'ai un grand nombre de fiches clients enregistrées en autant de classeurs sous mon D:\Fiches clients\

Je souhaiterais importer toutes les données saisies dans chacune de ces fiches (plusieurs RANGE), dans un seul classeur de destination (1 client par ligne à partir de la ligne 2). Le classeur de destination est sous D:\Destination Fiches\

Pour l'exemple, je vous joins 2 fiches clients (avec explications en commentaires des RANGE à exporter) et le fichier de centralisation (avec les entêtes pré-renseignées).

Je vous remercie de votre aide précieuse.

Cordialement.

Bonjour

U essai à tester. Te convient-il ?

Bye !

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

gmb a écrit :

Bonjour

U essai à tester. Te convient-il ?

Bye !

Bonjour et merci pour ta réponse : ça me convient tout à fait.

Vous êtes au top sur ce forum !

Encore merci.

Bonjour SABV,

Merci, cette version fonctionne bien également.

Vous êtes au top sur ce forum !

Janigrel