Sub wczytaj_pliki()
Dim katalog As String, Plik As String

katalog = "C:\Users\Robert\Desktop\Test\" ' katalog z plikami
Plik = Dir(katalog & "*.txt")
While Plik <> ""
Worksheets.Add.Name = Plik

Call zapis(Plik, katalog & Plik)
Plik = Dir
Wend

End Sub

Function zapis(arkusz As String, zrodlo As String)

    With Sheets(arkusz).QueryTables.Add(Connection:="TEXT;" & zrodlo, Destination:=Range("$A$1"))
        .Name = arkusz
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .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
End Function

Sub wczytaj_pliki()
aktywny_plik = Excel.ActiveWorkbook.Name 'nazwa aktywnego pliku
Cells.Clear ' czyszczenie arkusza
wiersz = 1 ' ustawienie pierwszego wiersze
Set fs = Application.FileSearch
katalog = "d:\moje\vba\pliki\" ' katalog z plikami
With fs
    .LookIn = katalog ' szukamy plikow w tym katalogu
    .Filename = "*.txt" ' rozszezenie plikow
    If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then ' sprawdzenie czy sa takie pliki
        For i = 1 To .FoundFiles.Count 'petla plikow od 1 do liczby plikow
                Name = fs.FoundFiles(i) ' sciezka bieżącego pliku txt
                Workbooks.OpenText Filename:=fs.FoundFiles(i), Origin:=852, _
                StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(3, _
                1), Array(6, 1)), TrailingMinusNumbers:=Tru 'sposob wczytania pliku txt do excela
                
                wiersz_pliku_txt = 1 ' ustawienie pierwszego wiersze pliku txt
                
            Do While Cells(wiersz_pliku_txt, 1) <> ""
                Workbooks(aktywny_plik).Sheets(1).Cells(wiersz, 1) = Cells(wiersz_pliku_txt, 1) 'kopiowanie pierwszej kolumny
                Workbooks(aktywny_plik).Sheets(1).Cells(wiersz, 2) = Cells(wiersz_pliku_txt, 2) 'kopiowanie drugiej kolumny
                'dodaj takich wierszy ile chcesz wczytac klumn lub zrob petle
                wiersz_pliku_txt = wiersz_pliku_txt + 1 'kolejny wiersz pliku txt
                wiersz = wiersz + 1 ' kolejny wiersz pliku z
            Loop
                Excel.ActiveWorkbook.Close False ' zamkniecie pliku txt
        Next i ' nastepny plik txt
        
    Else
        MsgBox "There were no files found." 'informacja ze nie ma takich plikow
    End If
End With

End Sub