Autres Convertir un fichier CSV en XLSX avec un macro

Const sPath As String = "C:\Users\STAPLE\Downloads\Excel\"
Public NomX$
Sub Traitement()
Application.ScreenUpdating = False
Import_CSV
SaveAs_XLSX
End Sub
Private Sub Import_CSV()
Dim Fichier_CSV$
Fichier_CSV = "Extraction 040522 MASTER1.csv"
NomX = Split(Fichier_CSV, ".")(0)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & sPath & Fichier_CSV, Destination:=Range("$A$1"))
        .Name = "Extraction 040522 MASTER1"
        .FieldNames = True
        .PreserveFormatting = True
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileSemicolonDelimiter = True
        .TextFileDecimalSeparator = "."
        .Refresh BackgroundQuery:=False
    End With
End Sub
Private Sub SaveAs_XLSX()
ActiveSheet.Copy
ActiveWorkbook.SaveAs sPath & NomX & " .xlsx", 51
ActiveWorkbook.Close False
End Sub

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\Shadow81\Documents\Excel extraction\CSV\" '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
'   delimiteur avec ";"
    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, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
    ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
    (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
    Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
    33, 1)), TrailingMinusNumbers:=True
'       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