Help needed in importing a text file to excel

Hi. It is necessary to see the text file and the result, save it in excel.

Try recording a macro when you either open one of the text files via File>Open... or import it to a sheet using Data>From Text.

Either should generate code that can be adapted to work with your list of files.

Sub uuu()
    Dim folder_path$, file_name$
'--------------------------------
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        folder_path = .SelectedItems(1)
    End With
    folder_path = folder_path & IIf(Right(folder_path, 1) = Application.PathSeparator, "", Application.PathSeparator)
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set sh = Sheets.Add
    
    With sh
        file_name = Dir(folder_path & "*.txt")
        Do While file_name <> ""
            a = GetDataFromText(folder_path & file_name, "utf-8", vbCrLf, " ")
            .UsedRange.EntireRow.Delete
            .Cells(1, 1).Resize(UBound(a) + 1, UBound(a, 2) + 1) = a
            .Copy
            ActiveWorkbook.SaveAs FileName:=folder_path & Replace(file_name, "txt", "xlsx"), _
                                                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWindow.Close
            file_name = Dir
        Loop
        .Delete
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Beep
End Sub

Function GetDataFromText(file_path$, file_charset$, row_delimeter$, column_delimeter$) As Variant
    Dim a()
    Dim rw, cl
    Dim i&, j&
    Dim txt$
'---------------------
    With CreateObject("ADODB.Stream")
        .Charset = file_charset
        .Open
        .LoadFromFile file_path
        txt = .ReadText
        .Close
    End With
    
    rw = Split(txt, row_delimeter)
    cl = Split(rw(0), column_delimeter)
    
    ReDim a(0 To UBound(rw), 0 To UBound(cl))
    For i = 0 To UBound(a)
        cl = Split(rw(i), column_delimeter)
        For j = 0 To UBound(a, 2)
            a(i, j) = cl(j)
        Next
    Next
    
    GetDataFromText = a
End Function

This is how you would incorporate the variable file in the code.

Sub Macro1()
'
' Macro1 Macro
'

    Dim file As String
    file = "D:\New folder\New folder (2)\sampletext.txt"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & file, Destination:=Range("$B$1"))
        '.CommandType = 0
        .Name = "sampletext"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Columns("B:B").EntireColumn.AutoFit
End Sub

Hi Norie,
Thanks alot it works fine.Thanks for helping me

Collect all text files in a book

Sub uuu()
    Dim folder_path$, file_name$
    Dim i&
    Dim sh As Worksheet
'--------------------------------
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        folder_path = .SelectedItems(1)
    End With
    folder_path = folder_path & IIf(Right(folder_path, 1) = Application.PathSeparator, "", Application.PathSeparator)
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set sh = Sheets.Add
    i = 1
    
    With sh
        file_name = Dir(folder_path & "*.txt")
        Do While file_name <> ""
            a = GetDataFromText(folder_path & file_name, "utf-8", vbCrLf, " ")
            .Cells(i, 1).Resize(UBound(a), UBound(a, 2)) = a
            i = i + UBound(a)
            file_name = Dir
        Loop
        .Copy
        ActiveWorkbook.SaveAs Filename:=folder_path & "New File.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWindow.Close
        .Delete
    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Beep
End Sub

Function GetDataFromText(file_path$, file_charset$, row_delimeter$, column_delimeter$) As Variant
    Dim a()
    Dim rw, cl
    Dim i&, j&
    Dim txt$
'---------------------
    With CreateObject("ADODB.Stream")
        .Charset = file_charset
        .Open
        .LoadFromFile file_path
        txt = .ReadText
        .Close
    End With
    
    rw = Split(txt, row_delimeter)
    cl = Split(rw(0), column_delimeter)
    
    ReDim a(1 To UBound(rw) + 1, 1 To UBound(cl) + 1)
    For i = 1 To UBound(a)
        cl = Split(rw(i - 1), column_delimeter)
        For j = 1 To UBound(a, 2)
            a(i, j) = cl(j - 1)
        Next
    Next
    
    GetDataFromText = a
End Function