[Excel] Macro pour fusionner des fichiers

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

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

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

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

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?

Eventuellement, oui. (Désolé.)

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

Cool.

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