[Excel] Macro pour fusionner des fichiers
Résolu
Arn's
Messages postés
23
Date d'inscription
Statut
Membre
Dernière intervention
-
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention -
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention -
Bonjour à tous,
J'ai des fichiers Excel (2002) dans un même répertoire. Je souhaite, à l'aide d'une macro, créer un nouveau fichier, dans ce répertoire, qui regroupe tous les fichiers de ce répertoire dans une seule feuille, les uns en-dessous des autres (à la suite).
Par exemple, pour deux fichiers, fichier1 (5 lignes et 3 colonnes) et fichier2 (6 lignes et 4 colonnes), je veux obtenir un troisième fichier, fichier3, tel que :
Range("A1:C5") : contenu de fichier1
Range("A6:D12") : contenu de fichier2
Est-il possible de créer une macro qui produit ce résultat quel que soit le nombre de fichiers de mon répertoire, et quel que soit le nombre de lignes de chaque fichier ?
Je vous remercie d'avance pour vos réponses. N'hésitez pas à me poser des questions si vous voulez plus de détails.
J'ai des fichiers Excel (2002) dans un même répertoire. Je souhaite, à l'aide d'une macro, créer un nouveau fichier, dans ce répertoire, qui regroupe tous les fichiers de ce répertoire dans une seule feuille, les uns en-dessous des autres (à la suite).
Par exemple, pour deux fichiers, fichier1 (5 lignes et 3 colonnes) et fichier2 (6 lignes et 4 colonnes), je veux obtenir un troisième fichier, fichier3, tel que :
Range("A1:C5") : contenu de fichier1
Range("A6:D12") : contenu de fichier2
Est-il possible de créer une macro qui produit ce résultat quel que soit le nombre de fichiers de mon répertoire, et quel que soit le nombre de lignes de chaque fichier ?
Je vous remercie d'avance pour vos réponses. N'hésitez pas à me poser des questions si vous voulez plus de détails.
A voir également:
- [Excel] Macro pour fusionner des fichiers
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Comment fusionner des pdf sans logiciel - Guide
- Renommer des fichiers en masse - Guide
- Fusionner deux fichiers excel - Guide
12 réponses
Bien mangé?
Voici une solution. Si tu veux des détails, je peux répondre à certaines questions. Pas toutes car tout ce code n'est pas de moi... Par contre désolé pour les sources, je ne les ai pas notées.
A placer dans un module :
Sub réunion_fichiers()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, classeur As String
Dim Nbr As Long
Dim NBlignes As Integer, NBCol As Integer
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = Chemin
.SearchSubFolders = True
.Filename = xls
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
Application.DisplayAlerts = False
For Each NomFic In .FoundFiles
Workbooks.Open Filename:=NomFic
NBlignes = ActiveSheet.UsedRange.Rows.Count
NBCol = ActiveSheet.UsedRange.Columns.Count - 1
ActiveSheet.Range("A1").Offset(NBlignes, 0).Value = "'"
ActiveSheet.Range("A1").Offset(NBlignes + 1, NBCol).Name = "nom1"
ActiveSheet.Range("A1:nom1").Copy
ActiveWorkbook.Names("nom1").Delete
classeur = ActiveWorkbook.Name
Windows("ouvrir docs.xls").Activate
Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = classeur
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Windows(classeur).Activate
ActiveSheet.Range("A1").Offset(NBlignes, 0).Value = ""
ActiveWindow.Close
Next
End With
End Sub
Un peu brouillon mais efficace, il me semble...
Voici une solution. Si tu veux des détails, je peux répondre à certaines questions. Pas toutes car tout ce code n'est pas de moi... Par contre désolé pour les sources, je ne les ai pas notées.
A placer dans un module :
Sub réunion_fichiers()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, classeur As String
Dim Nbr As Long
Dim NBlignes As Integer, NBCol As Integer
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
.LookIn = Chemin
.SearchSubFolders = True
.Filename = xls
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
Nbr = .Execute
Application.DisplayAlerts = False
For Each NomFic In .FoundFiles
Workbooks.Open Filename:=NomFic
NBlignes = ActiveSheet.UsedRange.Rows.Count
NBCol = ActiveSheet.UsedRange.Columns.Count - 1
ActiveSheet.Range("A1").Offset(NBlignes, 0).Value = "'"
ActiveSheet.Range("A1").Offset(NBlignes + 1, NBCol).Name = "nom1"
ActiveSheet.Range("A1:nom1").Copy
ActiveWorkbook.Names("nom1").Delete
classeur = ActiveWorkbook.Name
Windows("ouvrir docs.xls").Activate
Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = classeur
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Windows(classeur).Activate
ActiveSheet.Range("A1").Offset(NBlignes, 0).Value = ""
ActiveWindow.Close
Next
End With
End Sub
Un peu brouillon mais efficace, il me semble...
Euh tu peux me traiter d'abruti!!! J'ai cherché 1/4 d'heure pour .... rien. Ton classeur nommé "macro" il faut juste l'appeler ouvrir docs.xls comme indiqué à cette ligne (dans la macro):
Windows("ouvrir docs.xls").Activate
Sinon change cette ligne pour indiquer :
Windows("macro.xls").Activate
Non cette macro ne créée pas de nouveau fichier. Tes fichiers seront tous réunis dans le classer "macro" (ou "ouvrir docs").
Windows("ouvrir docs.xls").Activate
Sinon change cette ligne pour indiquer :
Windows("macro.xls").Activate
Non cette macro ne créée pas de nouveau fichier. Tes fichiers seront tous réunis dans le classer "macro" (ou "ouvrir docs").
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Je dois pas l'utiliser correctement, je crois. Tu l'as testé, toi ? Moi j'ai créé deux fichiers tests ("classeur1" et "classeur2") dans un répertoire "test", et j'ai placé ma macro dans un fichier ("macro") extérieur à ce dossier. La macro est censée créér un nouveau fichier ? Parce que lorsque je l'éxécute, il ne se passe rien.
Bonjour,
Petite question préliminaire : Y a t'il des cellules vides dans les fichiers que vous souhaitez réunir?
Petite question préliminaire : Y a t'il des cellules vides dans les fichiers que vous souhaitez réunir?
Vous avez raison de demander, et d'ailleurs merci de vous pencher sur mon problème. Oui, je peux m'arranger pour que mes fichiers commencent tous en A1.
Ah par contre, non. (En fait, je peux difficilement décrire l'ensemble de ces fichiers, étant donné qu'ils ont des structures très hétérogènes.)
...
Comment dire ?
...
Ok, je suis un âne.
C'est bon, ça marche. Super, merci beaucoup, ça me sauve la vie.
Comment dire ?
...
Ok, je suis un âne.
C'est bon, ça marche. Super, merci beaucoup, ça me sauve la vie.
Bonjour,
Je débute avec les macro dans excel. Cependant j'ai 300 fichier excel à coller le un après les autres. J'ai cru comprendre que la macro ci dessus permettrait de realiser cela. Lorsque je copie et colle le code ci dessous j'ai un message d'erreur : Erreur de compilation End With attendu. Pourriez vous m'aider?
Sub réunion_fichiers()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, classeur As String
Dim Nbr As Long
Dim NBlignes As Integer, NBCol As Integer
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
End Sub
Windows("macro.xls").Activate
Je débute avec les macro dans excel. Cependant j'ai 300 fichier excel à coller le un après les autres. J'ai cru comprendre que la macro ci dessus permettrait de realiser cela. Lorsque je copie et colle le code ci dessous j'ai un message d'erreur : Erreur de compilation End With attendu. Pourriez vous m'aider?
Sub réunion_fichiers()
Dim ScanFic As Office.FileSearch
Dim NomFic As Variant
Dim Diag As String, fich As String, classeur As String
Dim Nbr As Long
Dim NBlignes As Integer, NBCol As Integer
Dim objShell As Object, objFolder As Object, oFolderItem As Object
Dim Chemin As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path
Set ScanFic = Application.FileSearch
With ScanFic
.NewSearch
End Sub
Windows("macro.xls").Activate
Salut,
Oui effectivement. Tu n'as pas pris toute la macro.
1- Créé un classeur Excel vide et appelle le "ouvrir docs"
2- créé dans ce classeur un module (ALT+F11 Insertion/module)
3- copie et colle tout le code contenu dans le post 9 ci dessus dans ce module
4- Ferme la fenêtre Visual Basic et lance la macro par ALT+F8 Exécuter.
Si problème, reviens ici pour poser toutes questions subsidiaires...
Oui effectivement. Tu n'as pas pris toute la macro.
1- Créé un classeur Excel vide et appelle le "ouvrir docs"
2- créé dans ce classeur un module (ALT+F11 Insertion/module)
3- copie et colle tout le code contenu dans le post 9 ci dessus dans ce module
4- Ferme la fenêtre Visual Basic et lance la macro par ALT+F8 Exécuter.
Si problème, reviens ici pour poser toutes questions subsidiaires...