Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

O

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.
 
Trier par date Trier par votes

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
 
Vote positif 0 Vote négatif
O

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.
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
O

océanne

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
O

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
 
Vote positif 0 Vote négatif

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.
 
Vote positif 0 Vote négatif
O

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
 
Vote positif 0 Vote négatif

dysorthographie

XLDnaute Accro
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!
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
422
Chaton77
C
  • Résolu(e)
XL 2019 Importer fichier csv sans consatener les colonnes
2 3
Réponses
34
Affichages
2 K
laurent950
  • Résolu(e)
XL 2010 Problème màj feuilles depuis fichiers CSV
2
Réponses
23
Affichages
2 K
cathodique
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
441
ph.vanne
J
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
764
jebibo
J
Z
  • Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
310
zendb
Z
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
326
eric72
E
L
  • Question
Autres Copier des données d’un fichier sans l’ouvrir juste en le sélectionnant via un UserForm
Réponses
6
Affichages
683
Liner77
L
L
  • Résolu(e)
Microsoft 365 Décompte via plusieurs fichiers CSV
Réponses
12
Affichages
615
WTF
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
2 K
Hutchy33
H
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…