Question codes VBA existant.

[Soleil11]

Bonjour,

Est-il possible de modifier le code ci-dessous ? Lorsque mon fichier "Consolider fichiers.xls" a été consolider automatiquement je sais pas de quel fichiers il provient. J'aimerais ajouté le "nom du fichier" en colomne "A1" pour chaque ligne ajoutée provenant des fichiers.xls qui on été copier depuis "H:\David Jones\New Folder" dans le fichier de consolidation. Je ne sais pas si cela est réalisable.

Merci d'avance pour votre aide.


Sub Consolidation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir("H:\David Jones\New Folder" & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open "H:\David Jones\New Folder" & "\" & 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

Bonne journée.🙂

 

[tototiti2008]

Re : Question codes VBA existant.

Bonjour Soleil1,

peut-être comme ca :

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir("H:\David Jones\New Folder" & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open "H:\David Jones\New Folder" & "\" & 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+1)).Select
ActiveSheet.Paste
Range("A" & CStr(Ligne)).value = Temp
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

 

[Soleil11]

Re : Question codes VBA existant.

C'est presque parfait, au fait j'aimerais insérer une nouvelle colomne avant la colomne A et ajouter le nom des différents fichiers ajoutés par ligne.

Bonjour Soleil1,

peut-être comme ca :

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir("H:\David Jones\New Folder" & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open "H:\David Jones\New Folder" & "\" & 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+1)).Select [COLOR="Red"]ajouter une colomne avant A et reporter le nom des fichier sur tout les lignes[/COLOR]
ActiveSheet.Paste
Range("A" & CStr(Ligne)).value = Temp
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Merci d'avance.

Soleil11

 

[tototiti2008]

Re : Question codes VBA existant.

Re,

alors peut-être comme ça :

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long, Ligne2 as Long
Temp = Dir("H:\David Jones\New Folder" & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Then
Workbooks.Open "H:\David Jones\New Folder" & "\" & Temp
Ligne2 = Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Rows.Count
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("B" & CStr(Ligne)).Select
ActiveSheet.Paste
Range("A" & CStr(Ligne), "A" & Ligne + Ligne2 - 1).value = Temp
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

 

[Soleil11]

Re : Question codes VBA existant.

Un grand merci a tototiti2008. et toute l'équipe.

Cela marche parfaitement.

Merci d'avance..

Soleil11

 

[Soleil11]

Re : Question codes VBA existant.

Un grand merci a tototiti2008. et toute l'équipe.

Cela marche parfaitement.

Merci d'avance..

Soleil11

Bonjour,

Je reviens sur ce code car j'aimerais encore le modifier et ajouter une condition ci-dessous la ligne en rouge que j'essaie de modifié et cela ne marche pas. Il faudrait ajouter tous les fichiers.xls qui commencent par FS10n* ou appliqué le filtre *FS10n*.

Exemple : like FS10n* or like *FS10n*.

Il ya ce code ci-dessous qui existe mais ce n'est pas ce que je veux.

If temp <> "Consolider fichiers.xls" And Left(temp, 4) <> "FS10n" Then

Sub Consolidation()
Dim Temp As String
Dim Ligne As Long, Ligne2 As Long
Temp = Dir("H:\David Jones\New Folder" & "\*.xls")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Consolider fichiers.xls" Like "FS10N" Then
Workbooks.Open "H:\David Jones\New Folder" & "\" & Temp
Ligne2 = Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Rows.Count
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("B" & CStr(Ligne)).Select
ActiveSheet.Paste
Range("A" & CStr(Ligne), "A" & Ligne + Ligne2 - 1).Value = Temp
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

Merci de votre aide.

Soleil11:🙂

 

[tototiti2008]

Re : Question codes VBA existant.

Bonjour Soleil11,

peut être :

If Temp <> "Consolider fichiers.xls" and ucase(Temp) Like "*FS10N*" then

 

[Soleil11]

Re : Question codes VBA existant.

Bonjour Soleil11,

peut être :

If Temp <> "Consolider fichiers.xls" and ucase(Temp) Like "*FS10N*" then

Bonjour,

J'ai testé et cela fonctionne très bien.

Soleil11😀