Consolider x fichiers excel de format identique dans un seul fichier de synthèse

[rizalo]

Bonjour à tous,

Je souhaite fusionner plusiers fichiers excel (03052 et 03053 dans mon exemple) dans un même fichier excel (consolidation test).

Mon fichier "consolidation test" doit obtenir en sortie dans ses 3 onglets, les lignes copiées dans les onglets correspondants des fichiers présents dans le même dossier.

Les lignes du premier onglet de 03052 doivent se retrouver dans le premier onglet du fichier "consolidation test".
Les lignes du premier onglet de 03053 doivent se retrouver dans le premier onglet du fichier "consolidation test", à la suite des données issues du fichier 03052.

j'ai commencé une macro qui récupère les données des premiers onglets mais j'ai trois problèmes.

1-la macro termine avec des données copiées dans le presse papier ce qui est inutile. Comment éviter ce message?
2-e voudrais que le nom du fichier source apparaisse sur chaque ligne collées dans le fichier consolidation. Ici le nom est collé une seule fois.
3-Je voudrais que la macro fonctionne sur tous les onglets des fichiers 03052 et 03053, mais je n'arrive pas à trouver la formule qui va bien.

Merci d'avance pour vos réponses,

Regarde la pièce jointe 03052.xls

Regarde la pièce jointe 03053.xls

Regarde la pièce jointe Consolidation test.xls

ma macro inséré dans le fichier "consolidation test"

Sub consolide()
Dim myVar As Long
Application.ScreenUpdating = False
ChDir ActiveWorkbook.Path
Set recap = ThisWorkbook
compteur = 1

nf = Dir("*.xls")
Do While nf <> ""
If nf <> recap.Name Then
On Error GoTo GestionDesErreurs
myVar = Application.WorksheetFunction _
.Match(nf, Worksheets(1).Range("A1:A9000"), 0)
On Error GoTo 0
If IsNumeric(myVar) = False Then
Transfert:
Workbooks.Open Filename:=nf
Workbooks(nf).Sheets(1).Range("A2:G1328").Copy
recap.Sheets(1).Range("B" & recap.Sheets(1).[B1000].End(xlUp).Row + 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Workbooks(nf).Close False
recap.Sheets(1).Range("A" & recap.Sheets(1).[A1000].End(xlUp).Row + 1) = nf
End If
End If
nf = Dir
Loop

Range("A1:B1").Select
GestionDesErreurs:
If Err = 1004 Then
Err = 0
Resume Transfert
End If

End Sub

 

[Efgé]

Re : Consolider x fichiers excel de format identique dans un seul fichier de synthèse

Bonjour
Ce n'est pas le plus compliqé mais pour le prmier point, vous pouvez mettre en tête de macro

Application.DisplayAlerts = False

Et avant le End Sub

Application.DisplayAlerts = True.

Cordialement

 

[Staple1600]

Re : Consolider x fichiers excel de format identique dans un seul fichier de synthèse

Bonsoir


Tu peux éviter le copier/coller en procédant ainsi

(remplace le code équivalent dans ton code pas celui-ci)

i = 1
Workbooks.Open Filename:=nf
With recap.Sheets(1)
.Range("B" & .[B65536].End(xlUp).Row + i)(1).Resize(1326, 6).Value = Workbooks(nf).Sheets(1).Range("A2:G1328").Value
End With
Workbooks(nf).Close False
i = i + 1
recap.Sheets(1).Range("A" & recap.Sheets(1).[A1000].End(xlUp).Row + 1) = nf

 

[rizalo]

Re : Consolider x fichiers excel de format identique dans un seul fichier de synthèse

Merci Jean Marcel,Efgé,Stapple

Je lis à peine vos réponse. Je n'ai pu tester que la macro faite par Jean Marcel qui m'a l'air de bien fonctionner.

Je regarde ça de plus près et poursuit la discussion si besoin.

Vraiment top ce forum et ses contributeurs!