Modif. de code VBA ...

[sofysofe]

Bonjour,
difficile de donner un Intitulé parlant ...

Alors voilà, j'ai récupéré le code ci-dessous (aimablement mis à dispo par JJ1 que je remercie encore au passage) :

Sub Compilation()
Dim Temp As String
Dim Ligne As Long
Temp = Dir(ActiveWorkbook.Path & "\*.csv")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then
Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
Workbooks("Recap.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

Il me permet (même si j'ai pas forcément besoin de traduire pour ceux qui seront à même de le compléter ...) de compiler tous les fichiers CSV contenus dans un répertoire. Ca marche surper (sachant que j'en ai 346 c'est très utile).
Par contre, il me manque un élément essentiel : les noms des csv contiennent la date du fichier, et j'en ai besoin. Il faudrait donc qu'une colonne supplémentaire du fichier Recap récupère la date de chaque fichier. Ils sont tous nommés comme suit :all_devices_default_view_20090128_100002.csv - c'est donc la date (aaaammjj en gras ci-dessus) qu'il faudrait que je récupère, et cerise sur le gateau, si j'ai pas besoin de reprendre le formatage, c'est encore mieux

Deuxième cerise sur le gâteau, si c'est possible de retirer les lignes de titre qui se répètent à chaque csv ajouté, là, c'est le top !!!!

Merci d'avance, ci-joint 3 CSV + le fichier Recap

 

[jp14]

Re : Modif. de code VBA ...

Bonjour

Ci dessous la procédure modifiée.

Sub Compilation()
Dim Temp As String
Dim Ligne As Long
[COLOR="Red"]Dim nom As String[/COLOR]
Temp = Dir(ActiveWorkbook.Path & "\*.csv")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then

Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
[COLOR="Red"]nom = Replace(ActiveWorkbook.Name, "all_devices_default_view_", "")
nom = Mid(nom, 1, InStrRev(nom, "_") - 1)[/COLOR]
Workbooks("Recap.xls").Sheets(1).Activate
[COLOR="Red"]Ligne = Sheets(1).Range("A65536").End(xlUp).Row + 1
Sheets(1).Range("A" & Ligne) = nom[/COLOR]
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

JP

 

[sofysofe]

Re : Modif. de code VBA ...

Merci JP !

C'est presque ce que je voulais : en fait, afin de pouvoir analyser le résultat final (par Tableau Croisé), j'ai besoin que la date soit dans une colonne indépendante, et que cette date soit présente sur chaque ligne

Ci-joint, j'ai mis un résultat que j'aimerai atteindre (donc avec une colonnes de dates formattées, et les ligne de titres répétitives supprimées)

 

[jp14]

Re : Modif. de code VBA ...

Bonjour (re)

La macro modifiée

Sub Compilation()
Dim Temp As String
Dim Ligne As Long, liged As Long
Dim nom As String
Temp = Dir(ActiveWorkbook.Path & "\*.csv")
Application.DisplayAlerts = False
Do While Temp <> ""
If Temp <> "Recap.xls" Then

Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Workbooks(Temp).Sheets(1).Range("A1").CurrentRegion.Copy
nom = Replace(ActiveWorkbook.Name, "all_devices_default_view_", "")
nom = Mid(nom, 1, InStrRev(nom, "_") - 1)
Workbooks("Recap.xls").Sheets(1).Activate
Ligne = Sheets(1).Range("b65536").End(xlUp).Row + 1
liged = Ligne + 1
Sheets(1).Range("a" & liged) = nom
Range("b" & CStr(Ligne)).Select
ActiveSheet.Paste
Sheets(1).Range("A" & liged & ":A" & Sheets(1).Range("b65536").End(xlUp).Row).FillDown
Sheets(1).Rows(liged - 1).Delete Shift:=xlUp
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
End Sub

A tester

JP

 

[sofysofe]

Re : Modif. de code VBA ...

Génial, c'est parfait !!!

Un grand merci à toi !