Convertir plusieurs fichiers CSV en Xlsx Fermé

Question

Bonjour, J'ai actuellement 68 fichiers en csv à transformer en fichiers xlsx. J'ai trouvé le code suivant : Sub CSVtoXLS() 'UpdatebyExtendoffice20170814 Dim xFd As FileDialog Dim xSPath As String Dim xCSVFile As String Dim xWsheet As String Application.DisplayAlerts = False Application.StatusBar = True xWsheet = ActiveWorkbook.Name Set xFd = Application.FileDialog(msoFileDialogFolderPicker) xFd.Title = "Select a folder:" If xFd.Show = -1 Then xSPath = xFd.SelectedItems(1) Else Exit Sub End If If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\" xCSVFile = Dir(xSPath & "*.csv") Do While xCSVFile <> "" Application.StatusBar = "Converting: " & xCSVFile Workbooks.Open Filename:=xSPath & xCSVFile ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xls", vbTextCompare), xlNormal ActiveWorkbook.Close Windows(xWsheet).Activate xCSVFile = Dir Loop Application.StatusBar = False Application.DisplayAlerts = True End Sub Cependant, lorsque les fichiers sont convertis, mais ne conserve pas le format (décalage des valeurs et séparation par des " ; " au mauvais endroit) Pouvez-vous m'aider ? :-) Merci par avance pour votre aide.

jee pee · Answer

Bonjour,

Pourquoi ne pas avoir essayé cette solution : https://forums.commentcamarche.net/forum/affich-37383583-fusionner-des-fichers-csv#8

Le script indiqué fusionne bien des CSV et en modifiant le SKIP=1 en SKIP=14 il devrait correspondre à tes fichiers. 

PS : Pour la mise en forme des sources, au dessus de la zone d'édition de tes messages, il y a des icônes pour l'enrichissement du texte. Celle qui a cet aspect <> ▼ permet d'appliquer au code, suivant une liste de valeurs, le format correspondant à sa nature. 
Un petit tuto là : https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code

cs_Le Pivert · Answer

Bonjour,

voir ceci qui est opérationnel:

https://www.mrexcel.com/board/threads/vba-convert-csv-to-xlsx.1056318/ 

Option Explicit
Sub ConvertCSVToXlsx()
    Dim myfile As String
    Dim oldfname As String, newfname As String
    Dim workfile
    Dim folderName As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
'   Capture name of current file
    myfile = ActiveWorkbook.Name
    
'   Set folder name to work through
    folderName = "C:\Users\LePivert\Documents\Nouveau dossier\" 'adapter chemin du dossier où se trouve les CSV
    
'   Loop through all CSV filres in folder
    workfile = Dir(folderName & "*.CSV")
    Do While workfile <> ""
'       Open CSV file
        Workbooks.Open Filename:=folderName & workfile
'       Capture name of old CSV file
        oldfname = ActiveWorkbook.FullName
'       Convert to XLSX
        newfname = folderName & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & ".xlsx"
        ActiveWorkbook.SaveAs Filename:=newfname, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
'       Delete old CSV file
        'Kill oldfname
        Windows(myfile).Activate
        workfile = Dir()
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Utilisateur anonyme · Answer

Bonjour, Excel utilise par défaut la virgule comme séparateur de colonnes. Or, les fichiers d'origine utilisent le point virgule. En modifiant la macro comme ceci on automatise la répartition des données dans des colonnes avant d'enregistrer le fichier en xls : Sub CSVtoXLS() 'UpdatebyExtendoffice20170814 Dim xFd As FileDialog Dim xSPath As String Dim xCSVFile As String Dim xWsheet As String Application.DisplayAlerts = False Application.StatusBar = True xWsheet = ActiveWorkbook.Name Set xFd = Application.FileDialog(msoFileDialogFolderPicker) xFd.Title = "Select a folder:" If xFd.Show = -1 Then xSPath = xFd.SelectedItems(1) Else Exit Sub End If If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\" xCSVFile = Dir(xSPath & "*.csv") Do While xCSVFile <> "" Application.StatusBar = "Converting: " & xCSVFile Workbooks.Open Filename:=xSPath & xCSVFile ' 'Répartir les données dans des colonnes en utilisant le séparateur ";" ActiveWorkbook.ActiveSheet.Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=True, Comma:=False, Space:=False, Other:=False ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xls", vbTextCompare), xlNormal ActiveWorkbook.Close Windows(xWsheet).Activate xCSVFile = Dir Loop Application.StatusBar = False Application.DisplayAlerts = True End Sub

Convertir plusieurs fichiers CSV en Xlsx

3 réponses

Discussions similaires