XL 2016 Importer plusieurs fichiers Excel dans un fichier

bibbip35 · 8 Octobre 2017

Bonjour

Je souhaiterais créer une macro afin d'importer plusieurs fichiers excel qui ont la mise en forme
afin de fusionner les donnée dans une feuille unique

J'ai essayé de réaliser une macro mais j'ai toujours une erreur de compilation ...

Auriez-vous une idée car la je ne comprends pas ...
Ci dessous mon code

Option Explicit
Sub Importfiles()
Dim WbDest As Workbook, WbSource As Workbook
Dim WksNewSheet As Worksheet
Dim NomFichier As String, Chemin As String
Dim I As Long
Set WbDest = ActiveWorkbook
Chemin = "C:\Users\CRICRI\Desktop\Recup. 07-10\Remontée INVENTAIRE ADEX 2017\"
NomFichier = Dir(Chemin & "*.xlsm") 'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire

Do While NomFichier <> "" 'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
Set WbSource = Workbooks.Open(Chemin & NomFichier) 'ouvre le fichier actuel à importer
Set WksNewSheet = WbSource.Sheets("Saisie") 'sélectionne la feuille de données à importer
WksNewSheet.Activate 'active cette feuille
WksNewSheet.Select
WksNewSheet.Range("A6:O" & Range("A65536").End(xlUp).Offset(1, 0).Row).Copy

'Range(Cells(1, 1), Cells(24, 24)).Select 'selection des données que l’on veut importer
'Selection.Copy 'copie les données sélectionnées
WbDest.Activate 'retourne vers le fichier de départ
'I = ActiveSheet.UsedRange.Rows.Count 'compte le nombre de lignes déjà utilisées dans ce fichier
'Cells(I + 1, 1).Select 'sélection de la cellule où on veut coller les données (la première vide)

Lg = Sheets("INVENTAIRE 2017").Range("A" & DernLigne55).Row 'derniere ligne vide fichier base
WbDest.Sheets("INVENTAIRE 2017").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'ActiveSheet.Paste 'colle les données
WbSource.Close 'ferme le fichier source
NomFichier = Dir 'va vers le fichier suivant à importer
Loop 'recommece la boucle avec le fichier suivant
WbDest.Activate
End Sub

Merci D'avance pour votre aide

Jacky67 · 8 Octobre 2017

Bonjour,
La macro ci-dessous copie la plage "A6:Ox" des fichiers présents dans le répertoire
"C:\Users\CRICRI\Desktop\Recup. 07-10\Remontée INVENTAIRE ADEX 2017\"
Vers la feuille "INVENTAIRE 2017" du classeur qui contient cette macro.
La feuille "INVENTAIRE 2017" doit exister
Les données de tous les classeurs source se trouvent sur une feuille "Saisie"

Code:

Sub Importfiles()
Dim NomFichier As String, Chemin As String
Chemin = "C:\Users\CRICRI\Desktop\Recup. 07-10\Remontée INVENTAIRE ADEX 2017\"
NomFichier = Dir(Chemin & "*.xlsm")  'définit les fichiers à importer en l’occurence tous les fichiers excel se trouvant dans ce répertoire
Do While NomFichier <> ""  'démarre la boucle jusqu’au dernier fichier disponible dans le répertoire
  Workbooks.Open Chemin & NomFichier  'ouvre le fichier actuel à importer
  With Sheets("Saisie")
    .Range("A6:O" & .Cells(.Rows.Count, "A").End(xlUp).Row).Copy
  End With
  With ThisWorkbook
    With .Sheets("INVENTAIRE 2017")
      .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
    End With
  End With
  Application.DisplayAlerts = False
  ActiveWorkbook.Close
  NomFichier = Dir  'va vers le fichier suivant à importer
Loop  'recommece la boucle avec le fichier suivant
End Sub

XL 2016 Importer plusieurs fichiers Excel dans un fichier

bibbip35

XLDnaute Occasionnel

Jacky67

XLDnaute Barbatruc

Discussions similaires