Microsoft 365 macro pour agréger différents fichiers CSV dans un fichier XLSM

[océanne]

Bonsoir le forum,

Je reviens vers vous, car j'ai un petit souci à vous soumettre.
J'ai dans un répertoire plusieurs dizaines de fichiers CSV qui comportent des noms différents, mais dont la structure est strictement la même et dont le séparateur de données est un point virgule.
Je souhaite par macro, boucler sur chacun de ces fichiers, les ouvrir et coller le contenu dans une feuille d'un fichier XLSM qui contient ma macro ci-dessous et qui se trouve dans le même répertoire que les fichiers CSV.

Sub Compilation_Oceanne()
Dim Temp As String
Dim Ligne As Long

Application.DisplayAlerts = False
'Blanchiment des lignes avant nouveau traitement de consolidation sur la feuille "Données consolidées des CSV"
Workbooks("Macro Oceanne.xlsm").Sheets("Données consolidées des CSV").Range("A3:CZ" & Range("A1048576").End(xlUp).Row + 1).ClearContents '+1 pour éviter de blanchir la ligne 2 si pas de données dessous
Temp = Dir(ActiveWorkbook.Path & "\*.csv")

Do While Temp <> ""
If Temp <> "Macro Oceanne.xlsm" Then
Application.Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True

Workbooks(Temp).Sheets(1).Range("A3:CZ" & Range("A1048576").End(xlUp).Row).Copy
Workbooks("Macro Oceanne.xlsm").Activate
Sheets("Données consolidées des CSV").Select
Ligne = Sheets("Données consolidées des CSV").Range("A1048576").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
MsgBox "L'agrégation des fichiers CSV est terminée"
End Sub

J'ai bien conscience que mon code est perfectible, mais mon souci premier, c'est que les données restent de la colonne A à la colonne D de ma feuille de consolidation (les points virgules comme ceci ;;;;;; et ne sont pas ventilées dans les cellules jusqu'en colonne CZ, comme je l'attends.
Au regard de mon code, l'un(e) d'entre vous a t il(elle) une idée ?
Pour des raisons de confidentialité, je ne peux pas vous joindre de fichier CSV, mais si nécessaire, j'en anonymiserai un ou deux.

D'avance merci pour votre aide, je coince.
Oceanne.

 

[sylvanu]

Bonsoir Océanne,
Sans fichier test, on ne peut guère qu'extrapoler.
Une possibilité sans détruire la structure de votre code est de dispatcher vos données ligne par ligne en passant par un tableau et un split avec séparateur ";" :

' Dispatche données
LigneFin = Sheets("Données consolidées des CSV").Range("A1048576").End(xlUp).Row
For L = Ligne To LigneFin
    tablo = Split(Sheets("Données consolidées des CSV").Cells(L, "A"), ";") ' séparateur ";"
    For C = LBound(tablo) To UBound(tablo)
        Cells(L, C+1) = tablo(C)
    Next C
Next L

Donc cela ferait un truc du genre :

Sub Compilation_Oceanne()
Dim Temp As String
Dim Ligne As Long, LigneFin As Long, L%, C%, tablo

Application.DisplayAlerts = False
'Blanchiment des lignes avant nouveau traitement de consolidation sur la feuille "Données consolidées des CSV"
Workbooks("Macro Oceanne.xlsm").Sheets("Données consolidées des CSV").Range("A3:CZ" & Range("A1048576").End(xlUp).Row + 1).ClearContents '+1 pour éviter de blanchir la ligne 2 si pas de données dessous
Temp = Dir(ActiveWorkbook.Path & "\*.csv")

Do While Temp <> ""
If Temp <> "Macro Oceanne.xlsm" Then
Application.Workbooks.Open ActiveWorkbook.Path & "\" & Temp
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True

Workbooks(Temp).Sheets(1).Range("A3:CZ" & Range("A1048576").End(xlUp).Row).Copy
Workbooks("Macro Oceanne.xlsm").Activate
Sheets("Données consolidées des CSV").Select
Ligne = Sheets("Données consolidées des CSV").Range("A1048576").End(xlUp).Row + 1
Range("A" & CStr(Ligne)).Select
ActiveSheet.Paste
' Dispatche données
LigneFin = Sheets("Données consolidées des CSV").Range("A1048576").End(xlUp).Row
For L = Ligne To LigneFin
    tablo = Split(Sheets("Données consolidées des CSV").Cells(L, "A"), ";") ' séparateur ";"
    For C = LBound(tablo) To UBound(tablo)
        Cells(L, C+1) = tablo(C)
    Next C
Next L
Workbooks(Temp).Close
End If
Temp = Dir
Loop
Range("A1").Select
Application.DisplayAlerts = True
MsgBox "L'agrégation des fichiers CSV est terminée"
End Sub

 

[océanne]

Merci Sylvanu de vous être si vite penché sur mon problème.
A première vue, le souci persiste, mais je vais poursuivre mes tests et reviendrai vers vous.
Il me semble que ce sont les deux premières lignes dans les fichiers CSV, les étiquettes de colonne en fait, qui provoquent mon problème.
Bonne soirée Sylvanu, le forum.
Oceanne.

 

[sylvanu]

Si vous avez des lignes du type a;b;c;d;e;f ... dans votre csv elles devraient être ventilées correctement.

 

[dysorthographie]

Bonsoir,

Sub test()
Dim Cn As Object, Tables() As String, Table, DerL As Long
Const MyRep = "C:\Myrep", AvecTitre = True
Set Cn = CreateObject("Adodb.Connection")
With Cn
    .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyRep & ";Extended Properties=""Text;HDR=" & Array("No", "YES")(Abs(AvecTitre)) & ";FMT=Delimited;"""
     Tables() = ListeTables(Cn)
     For Each Table In Tables
        ShemaIn MyRep, Replace(CStr(Table), "#", "."), "Delimited(;)"
        DerL = Sheets("Feuil1").UsedRange.Rows.Count
        If DerL = 1 Then DerL = 0
        Sheets("Feuil1").Cells(DerL + 1, "A").Select
        Sheets("Feuil1").Cells(DerL + 1, "A").CopyFromRecordset .Execute("select * from [" & Table & "]")
     Next
    .Close
End With
Set Cn = Nothing
End Sub
Property Get ListeTables(Connexion As Object) As String()
Dim t() As String, i As Integer
TableToutes = False
With Connexion.OpenSchema(20)
    While Not .EOF
        ReDim Preserve t(i)
        t(i) = !TABLE_NAME
        i = i + 1
        .MoveNext
    Wend
    .Close
    ListeTables = t
End With
End Property
Public Sub ShemaIn(Server As String, fichier As String, Delimited As String)
Dim txt As String
txt = "[" & fichier & "]" & vbCrLf & "Format= " & Delimited
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Server & "\schema.ini", 2, True)
NewFichier.Write txt
NewFichier.Close
 Set NewFichier = Nothing
Set fso = Nothing
End Sub

 

[océanne]

Bonjour le Forum,
Merci également à Dysorthographie, j'essayerai de mettre en oeuvre dès ce soir. Je constate que le code est assez éloigné de mon premier projet....mais je vais essayer de comprendre.
Oceanne

 

[cp4]

Bonjour @océanne , @dysorthographie , @sylvanu ,

@océanne: J'ai trouvé ceci, ça pourrait te rendre service pour ne traiter qu'un seul csv en passant par le DOS.

Bonne journée.

 

[océanne]

Merci pour ton appui cp4, je ne connaissais pas cette astuce. Je pense que l'on doit également parvenir à un résultat via MS QUERY.
Cela dit, je vais poursuivre en VBA, car la finalité est que je mette à disposition la macro auprès d'utilisateurs qui ne pratiquent pas.
Belle journée à tous

 

[cp4]

Re, J'ai déniché ceci qui compile des fichiers csv avec une ligne d'entete en un seul fichier csv.
Les fichiers csv à compiler sont mis dans un dossier nommé "CSV_ENTREE" et créer un dossier "SORTIE" qui recevra le fichier final qui sera nommé "combined.csv".

J'ai testé si les fichiers ont la même structure (une seule ligne d'entête), le fichier de sortie n'aura qu'une seule ligne d'entête.

Bonne soirée.

 

[océanne]

Bonsoir Sylvanu, Dysorthographie, Cp4, le forum

J’ai intégré le code de Dysorthographie dans mon classeur et le résultat est assez probant. J’ai encore quelques lignes qui ne sont pas traitées, mais je pense que le souci provient du fichier CSV d’entrée.

Merci à vous trois pour votre aide
Bonne soirée à tous
Oceanne

 

[dysorthographie]

Bonsoir,
Notes cette variable AvecTitre = True veut dire que la première ligne du CSV ce trouve être le titre des collonnes ou entêtes de colonnes !

Si ce n'est pas le cas il faut faire AvecTitre = False pour inclure la première ligne des CSV!