Convertir en masse .csv en .xls

Sub ListeFichier()
Dim Dossier As FileDialog
      Chemin = ActiveWorkbook.Path & Application.PathSeparator
Set Dossier = Application.FileDialog(msoFileDialogOpen)
   With Dossier
      .AllowMultiSelect = False
      .InitialFileName = Chemin
      .Title = "Choix d'une fichier Elise"
            With .Filters
               .Clear
               .Add "Fichiers Textes", "*.csv", 1
            End With
      .InitialFileName = ""
      'Interdit la multi sélection
      .AllowMultiSelect = False
         If .Show = -1 Then
               Fichier = .SelectedItems(1)
               Call LireFichier(Fichier)
            Else
               Exit Sub
         End If
   End With
Set Dossier = Nothing
End Sub

Sub LireFichier(NomFichier)
Dim Ar() As String
   With Application
      .ScreenUpdating = False
      .EnableEvents = False
      .Calculation = xlManual
   End With
Sep = ";"
Lig = Range("A" & Rows.Count).End(xlUp).Row + 1
If Lig = 2 Then Lig = 1
' -------------------------------------
    Open NomFichier For Input As #1
        Do While Not EOF(1)
            Line Input #1, Chaine
               Ar = Split(Chaine, Sep)
               Col = 1
                  For X = LBound(Ar) To UBound(Ar)
                     Cells(Lig, Col) = Ar(X)
                     Col = Col + 1
                  Next
            Lig = Lig + 1
        Loop
    Close #1
' -------------------------------------
   With Application
      .ScreenUpdating = True
      .Calculation = xlCalculationAutomatic
      .EnableEvents = True
      .CutCopyMode = False
      .Goto [A1], True
   End With
   MsgBox "Terminer"
End Sub