Aide sur code VBA macro

[Soleil11]

Bonjur,

Le code suivant permet de récupérer toutes les lignes de tous les fichiers XLS se trouvant dans un même répertoire pour les consolider et les mettre dans un seul fichier, et j'aimerais utliser ce code pour l'une de mes consolidation.

Malheuresement, je n'ai pas beaucoup de connaissance en VBA, que dois-je changer sur cette macro pour l'adapter à ma situation ?

Mon répertoir est le suivant : "H:\David Jones\New Folder\"

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir(ActiveWorkbook.Path & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Consolider fichiers.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Merci d'avance.

Soleil11🙂

 

[Dull]

Re : Aide sur code VBA macro

Salut Soleil11, le Forum

Peut-être comme cela

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir([B]"H:\David Jones\New Folder"[/B] &  "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open [B]"H:\David Jones\New Folder" [/B]& "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Consolider fichiers.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

A Tester

Bonne Journée

 

[Soleil11]

Re : Aide sur code VBA macro

Salut Soleil11, le Forum

Peut-être comme cela

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir([B]"H:\David Jones\New Folder"[/B] &  "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open [B]"H:\David Jones\New Folder" [/B]& "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Consolider fichiers.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

A Tester

Bonne Journée

Rebonjour,

Merci pour votre aide cela marche surper bien, j'ai encore une faveur à vous demander est-il possible d'ajouter les noms des fichiers ajoutés par exemple A.xls B.xls C.xls D.xls etc. dans le fichier de consolidation finale "Consolider fichiers.xls" en colomne A1 pour savoir quel fichier a été importé.

Merci pour votre aide.

Soleil11