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

océanne

XLDnaute Occasionnel
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.

VB:
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

XLDnaute Barbatruc
Supporter XLD
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 ";" :
Code:
' 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 :
VB:
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

XLDnaute Occasionnel
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.
 

dysorthographie

XLDnaute Accro
Bonsoir,
VB:
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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
 

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth