Convertir bloc notes en .xls

'Procédure de démarrage.
Sub ConvertiRep()
Dim fs, F, f1, s, sf
Dim Chemin As String, CheminCopie As String, NomFichier As String
'-----------------------------------------------------------
    'Sélectionner le répertoire des fichiers source
    Chemin = SelectionRep
    'Eventuellement remplacer par
    'Chemin = "C:\Documents and Settings\k004418\Bureau\test 2\"
'-----------------------------------------------------------
    'Sélectionner le répertoire de copie des fichiers
    CheminCopie = SelectionRep
'-----------------------------------------------------------
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    For Each f1 In sf
        If f1.Name Like "*SER*" Then
            OuvreTxtXls Chemin & f1.Name
            s = Split(f1.Name, ".")
            ActiveWorkbook.SaveAs CheminCopie & s(0) & ".xlsx"
            ActiveWorkbook.Close
        End If
    Next
    Set sf = Nothing
    Set F = Nothing
    Set fs = Nothing
End Sub

Function SelectionRep()
Const ssfTous = &H1
Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", ssfTous)
    Set oFolderItem = objFolder.Items.Item
    SelectionRep = oFolderItem.Path & "\"
    Set objShell = Nothing
    Set objFolder = Nothing
    Set oFolderItem = Nothing
End Function

Sub OuvreTxtXls(Fichier As String)
    Workbooks.OpenText Filename:=Fichier, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
End Sub