[Excel] Macro pour fusionner des fichiers Résolu/Fermé

Question

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.

pijaku · Accepted Answer

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

pijaku · Answer

Bonjour,
Petite question préliminaire : Y a t'il des cellules vides dans les fichiers que vous souhaitez réunir?

Arn's · Answer

Eventuellement, oui. (Désolé.)

Arn's · Answer

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.

Arn's · Answer

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

Arn's · Answer

Je vais manger, je ne pourrai pas vous répondre tout de suite. Bon courage.

Arn's · Answer

(Oui, bien mangé, merci.)
Wow ! Quelle rapidité ! Je vais tester ça tout de suite.

Arn's · Answer

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.

Arn's · Answer

Cool.

pijaku · Answer

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").

Arn's · Answer

...
Comment dire ?
...
Ok, je suis un âne.
C'est bon, ça marche. Super, merci beaucoup, ça me sauve la vie.

Eorle · Answer

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

[Excel] Macro pour fusionner des fichiers

12 réponses

Discussions similaires