Option Explicit
 
Const TypeFichier As String = "txt"
Const Separateur As String = vbTab
 
Sub DelFeuilles()
Dim i As Long
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> ShParam.Name Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
        End If
    Next i
End Sub
 
Private Function Extension(sFichier As String) As String
Dim sExt As String
    sExt = Mid$(sFichier, InStrRev(sFichier, "." ) + 1)
    Extension = sExt
End Function
 
Private Sub Lire(ByVal sNomFichier As String)
Dim sChaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Ws As Worksheet
 
    Close
 
    NumFichier = FreeFile
    iRow = 1
 
    Open sNomFichier For Input As #NumFichier
    Set Ws = ThisWorkbook.Sheets.Add
    Ws.Move After:=Worksheets(Sheets.Count)
    Do While Not EOF(NumFichier)
        iCol = 1
        Line Input #NumFichier, sChaine
        Ar = Split(sChaine, Separateur)
        For i = LBound(Ar) To UBound(Ar)
            Ws.Cells(iRow, iCol) = Ar(i)
            iCol = iCol + 1
        Next i
        iRow = iRow + 1
    Loop
    Close #NumFichier
End Sub
 
Private Sub ListeFichiers(sDossier As String)
Dim sFichier As String, sChemin As String
Dim sExtension As String
 
    sFichier = Dir$(sDossier & "\*." & TypeFichier)
    Do While Len(sFichier) > 0
        sChemin = sDossier & "\" & sFichier
        sExtension = Extension(sChemin)
        If UCase$(sExtension) = UCase$(TypeFichier) Then
            Lire sChemin
        End If
        sFichier = Dir$()
    Loop
End Sub
 
Private Sub ListeFichiersRecur(sDossier As String, bRecur As Boolean)
Dim FSO As Object
Dim DossierSource As Object
Dim SousDossier As Object
Dim Fichier As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject" )
    Set DossierSource = FSO.GetFolder(sDossier)
 
    For Each Fichier In DossierSource.Files
        If UCase$(FSO.GetExtensionName(Fichier)) Like UCase$(TypeFichier) Then
            Lire Fichier
        End If
    Next Fichier
 
    If bRecur Then
        For Each SousDossier In DossierSource.SubFolders
            ListeFichiersRecur SousDossier.Path, True
        Next SousDossier
    End If
 
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub
 
Sub SelDossier()
Dim sChemin As String
 
    sChemin = ThisWorkbook.Path
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le Dossier"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.ScreenUpdating = False
            ListeFichiers .SelectedItems(1)
            Application.ScreenUpdating = True
        End If
    End With
End Sub
 
Sub SelDossierRecur()
Dim sChemin As String
 
    sChemin = ThisWorkbook.Path
 
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = sChemin & "\"
        .Title = "Sélectionner le Dossier : Recherche Récursive"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .ButtonName = "Sélection Dossier"
        .Show
        If .SelectedItems.Count > 0 Then
            Application.ScreenUpdating = False
            ListeFichiersRecur .SelectedItems(1), True
            Application.ScreenUpdating = True
        End If
    End With
End Sub