XL 2016 Convertir plusieurs CSV UTF 8 en XLSX

Const sExtension As String = "csv"
Const sNewExtension As String = "xlsx"
Const TypeFichier = "csv"
 
Dim sDossier As String
Dim FSO As Object
Dim Dossier As Object
Dim sFichier As String, F As String
Dim Pos As Long, i As Long, sExt As String
Dim TFichier() As String
Dim sNom As String
 
sDossier = ThisWorkbook.Path
    
    Application.ScreenUpdating = False
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(sDossier)
 
    TFichier = Split(TypeFichier, ";")
 
    sFichier = Dir$(sDossier & "\*.*")
 
    Do While Len(sFichier) > 0
        F = FSO.GetFileName(sFichier)
        For i = LBound(TFichier) To UBound(TFichier)
            If UCase(sFichier) <> UCase(ThisWorkbook.Name) Then
                Pos = InStr(F, TFichier(i))
                sExt = FSO.GetExtensionName(F)
                If Pos > 0 And UCase(sExt) = UCase(sExtension) Then
                    sNom = Left$(F, Len(F) - Len(sExt))
 
                    Workbooks.Open Filename:=sDossier & "\" & sFichier, local:=True
                    Application.DisplayAlerts = False
                    ActiveWorkbook.SaveAs Filename:=sDossier & "\" & sNom & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
                    ActiveWorkbook.Close
                    Application.DisplayAlerts = True
 
                    Nb = Nb + 1
                End If
            End If
        Next i
        sFichier = Dir$()
        Application.StatusBar = Nb
    Loop
 
   ' If bSousDossier Then
    '    For Each Dossier In Dossier.SubFolders
     '       ChangerExtensionFichiers Dossier.Path, True
      '  Next Dossier
    'End If
 
    Application.ScreenUpdating = True
    Set Dossier = Nothing
    Set FSO = Nothing
End Sub