Importation d'un .txt séparé par Tabulation ou par ";"

Bonjour tout le monde

j'ai trouvé ce code qui me permet d'importer des .txt dont les données sont séparées par une tabulation et j'aimerai également qu'il puisse importer des .txt dans le cas ou les données seraient séparées par ";" mais je ne vois pas comment faire.

Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xFiles As New Collection
Dim I As Long
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder [Kutools for Excel]"
If xFileDialog.Show = -1 Then
      xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Then
      MsgBox "No files found", vbInformation, "Kutools for Excel"
      Exit Sub
End If
Do While xFile <> ""
      xFiles.Add xFile, xFile
      xFile = Dir()
Loop
Set xToBook = ThisWorkbook
If xFiles.Count > 0 Then
      For I = 1 To xFiles.Count
              Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
              xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
              On Error Resume Next
              ActiveSheet.Name = xWb.Name
              On Error GoTo 0
               xWb.Close False
         Next
End If

Je vous remercie d'avance,

Paul

Bonjour,

Sub Macro1()
'
Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xFiles As New Collection
Dim I As Long
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder [Kutools for Excel]"
If xFileDialog.Show = -1 Then
      xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
If xFile = "" Then
      MsgBox "No files found", vbInformation, "Kutools for Excel"
      Exit Sub
End If
Do While xFile <> ""
      xFiles.Add xFile, xFile
      xFile = Dir()
Loop
Set xToBook = ThisWorkbook
If xFiles.Count > 0 Then
      For I = 1 To xFiles.Count
              Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
              xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
              On Error Resume Next
              ActiveSheet.Name = xWb.Name
              On Error GoTo 0
               xWb.Close False

Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=";", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

         Next
End If

End Sub

ça marche parfaitement, je te remercie !

Bonne journée

Paul

Rechercher des sujets similaires à "importation txt separe tabulation"