XL 2016 Macro pour compiler fichiers excel + Macro pour empiler tableaux

[razorlight]

Bonjour à tous,

Je vous prie d'avance de m'excuser si le sujet a été traité, j'ai eu beau chercher je n'ai pas trouvé de solution à la problématique à laquelle je fais face.
Voici la situation de départ : je reçois régulièrement une 30aine de fichiers XLS, identique sur la forme (colonne).
Régulièrement, j'ouvre un par un ces fichiers et copie la feuille contenant le tableau pour incrémenter un fichier excel "récapitulatif".

Puis, sur mon nouveau fichier excel "récapitulatif" composé de ma 30aine d'onglets, je crée un onglet "synthèse" et compile chaque tableau de chaque onglet.

Bref, c'est long et fastidieux et terriblement frustrant quand on connait les capacités de l'outil VBA. Je précise, je travail sur EXCEL 2016.


Afin de décomposer mon travail j'aimerais créer 2 macro que je nommerai "Rassembler" pour la fonction de rassembler les 30 fichiers excel en un seul fichier excel composé de 30 onglets (appelé RECAP) puis une autre permettant la création d'un onglet "synthèse" avec les 30 tableaux compilés.
J'espère avoir été clair . Pour anticiper la question, oui la même information apparaitrait 2 fois dans le même document, mais c'est utile pour moi de le conserver (même si je sais que les filtres peuvent m'aider à isoler et que ça alourdira le document).

Je ne sais pas du tout comment créer la première MACRO "Rassembler", j'ai trouvé ça sur une autre discussion ;

Sub RASSEMBLER()

Dim Chemin As String
Application.ScreenUpdating = False
Chemin = "C:\chemin"
Ouvrir Chemin
Application.ScreenUpdating = True
If msg <> "" Then _
MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub

Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
Application.DisplayAlerts = False 'Evite les messages d'Excel
'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
Application.EnableEvents = False
NomFich = Dir(Chemin & "*.xls")
If NomFich = "" Then
MsgBox "Aucun fichier trouvé dans " & Chemin
Exit Sub
End If
Do While NomFich <> ""
Set CL2 = Workbooks.Open(Chemin & NomFich)
DoEvents
Copie CL2
CL2.Close False
DoEvents
ThisWorkbook.Save 'enregistrement du classeur après chaque copie
DoEvents
NomFich = Dir
Loop
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub


Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
Set FL1 = ThisWorkbook.Worksheets("feuil1") 'feuille où les données sont collées
For Each LaFeuille In CL2.Worksheets 'parcours du classeur à copier
'On vérifie que la feuille n'est pas vide
If Not (LaFeuille.UsedRange.Address = "$A$1" And Range("A1") = "") Then
derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
On Error Resume Next
LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
DoEvents
If Err <> 0 Then
msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
On Error GoTo 0
End If
End If
Next
End Sub

Concernant la macro "Synthèse" j'ai essayé celle-ci mais qui n'a pas fonctionné car elle ne m'a copié que la 1ère feuille sans la deuxième plus bas.

Sub SYNTHESE()
'
' SYNTHESE Macro

Sheets(2).Range("a4:j" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
Destination:=Sheets(1).[a4]
Sheets(3).Range("a4:b" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
Destination:=Sheets(1).Cells(Rows.Count, 2).End(xlUp)(2)

End Sub

J'appelle à l'aide, petit débutant que je suis, pour une opération pas si complexe mais qui m'allègerait beaucoup la vie.
Je vous remercie.

 

[razorlight]

Je vais me renseigner. Merci !