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
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