Sub TransfertTxtVersExcel()
Dim Dossier$, x As Byte
Dim wb1 As Workbook, wb2 As Workbook, ws1 As Worksheet
Set wb1 = ThisWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count > 0 Then
Dossier = .SelectedItems(1)
End If
End With
If Dossier = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileSearch
.NewSearch
.Filename = "*.txt"
.LookIn = Dossier
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For x = 1 To .Count
wb1.Sheets.Add after:=wb1.Worksheets(Sheets.Count)
Set ws1 = ActiveSheet
Workbooks.Open Dossier & "\" & Dir(.Item(x))
Set wb2 = ActiveWorkbook
With wb2
.Sheets(1).UsedRange.Copy ws1.Range("A1")
ws1.Name = Left(.Name, Len(.Name) - 4)
.Close False
End With
Next x
End With
End If
End With
ThisWorkbook.Sheets("feuil1").Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub