XL 2013 Import depuis plusieurs classeurs l'un à la suite de l'autre

[Leguyl]

Bonsoir à tou(te)s,

J'ai un classeur nommé "Synthèse", il ne contient qu'une seule feuille du même nom et un tableau nommé tabSynthèse.

J'aimerais importer, dans ce tableau, les données des classeurs import1, import2, trucmuche3, bidule4... (plus de 50 classeurs).

Je ne sais comment faire pour que les données de chaque classeur se suivent dans mon tableau.

Merci d'avance pour votre aide.

 

[Compte Supprimé 979]

Bonjour Leguyl,

Voici ce que tu peux faire

Sub Import()
  Dim WbkSrc As Workbook, ShtDest As Worksheet
  Dim NomFichier As String, sPath As String
  Dim Lig As Long
  ' Désactive le rafraichissement de l'écran
  Application.ScreenUpdating = False
  ' Définir la feuille de destination
  Set ShtDest = ThisWorkbook.Sheets("Synthèse")
  ' Ligne de départ du tableau
  Lig = 3
  ' Définir le chemin d'accès
  sPath = ThisWorkbook.Path & "\"
  ' Trouver le premer fichier à importer
  NomFichier = Dir(sPath & "*.xlsm")
  ' Si nom de fichier non vide
  Do While NomFichier <> ""
    ' Tester que le fichier trouvé ne soit pas celui-ci
    If NomFichier = ThisWorkbook.Name Then GoTo Suite
    ' Sinon, ouvrir le fichier
    Set WbkSrc = Workbooks.Open(sPath & NomFichier)
    ThisWorkbook.Activate
    '--------------------------------------------------------'
    ' Copie des données depuis la source vers la destination '
    '--------------------------------------------------------'
    ShtDest.Range("B" & Lig) = WbkSrc.Sheets("Tableau").[J3]
    ShtDest.Range("C" & Lig) = WbkSrc.Sheets("Tableau").[J4]
    ShtDest.Range("D" & Lig) = WbkSrc.Sheets("Tableau").[G2]
    ShtDest.Range("E" & Lig) = WbkSrc.Sheets("Tableau").[G3]
    ShtDest.Range("F" & Lig) = WbkSrc.Sheets("Tableau").[G4]
    ShtDest.Range("G" & Lig) = WbkSrc.Sheets("Tableau").[G5]
    ' Ajouter une ligne
    ShtDest.ListObjects("tabSynthèse").ListRows.Add AlwaysInsert:=False
    Lig = Lig + 1
    ' Fermer le classeur source
    WbkSrc.Close SaveChanges:=False
Suite:
    ' Suite des fichiers
    NomFichier = Dir()
  Loop
   
  'Sélection du tableau1
  Application.Goto Reference:="tabSynthèse"
  ' Réactiver l'écran
  Application.ScreenUpdating = True
End Sub

A+

 

[Leguyl]

Bonjour Bruno,

Merci beaucoup pour ta solution, ça marche parfaitement.

En plus le code VBA ainsi commenté aide à en comprendre la logique.

Bonne journée.

 

[Leguyl]

Bonjour,

J'ai tenté de modifier légèrement le code afin de pouvoir choisir à la souris le dossier où se trouve les fichiers à importer, comme ceci :

sPath = Application.FileDialog(msoFileDialogFolderPicker).Show

La boîte de dialogue s'ouvre bien mais quel que soit mon choix de dossier, il ne se passe rien après.