Note: The other languages of the website are Google-translated. Back to English
Увійти  \/ 
x
or
x
Реєстрація  \/ 
x

or

Як імпортувати кілька текстових файлів з папки на один аркуш?

Наприклад, тут у вас є папка з кількома текстовими файлами, і ви хочете імпортувати ці текстові файли в один робочий аркуш, як показано нижче. Замість того, щоб копіювати текстові файли по одному, чи існують хитрощі для швидкого імпорту текстових файлів з однієї папки на один аркуш?

Імпортуйте кілька текстових файлів з однієї папки на один аркуш за допомогою VBA

Імпортуйте текстовий файл в активну комірку за допомогою Kutools для Excel гарна ідея3


Ось код VBA може допомогти вам імпортувати всі текстові файли з однієї конкретної папки на новий аркуш.

1. Увімкніть книгу, до якої потрібно імпортувати текстові файли, та натисніть Alt + F11 клавіші для ввімкнення Microsoft Visual Basic для додатків вікна.

2. клацання Insert > Модулі, скопіюйте та вставте нижче код VBA в Модулі вікна.

VBA: Імпортуйте кілька текстових файлів з однієї папки на один аркуш

Sub Test()
'UpdatebyExtendoffice6/7/2016
    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
End Sub

3. прес F5 , щоб відобразити діалогове вікно та виберіть папку, яка містить текстові файли, які потрібно імпортувати. Дивіться знімок екрана:
doc імпортувати текстові файли з папки 1

4. клацання OK. Потім текстові файли були імпортовані в активну книгу як новий аркуш окремо.
doc імпортувати текстові файли з папки 2


Якщо ви хочете імпортувати один текстовий файл до певної комірки або діапазону, ви можете подати заявку Kutools для ExcelАвтора Вставити файл у курсор утиліта

Kutools для Excel, з більш ніж 300 зручні функції, полегшує вам роботу. 

після безкоштовна установка Kutools для Excel, будь-ласка, виконайте наведені нижче дії:

1. Виділіть комірку, до якої потрібно імпортувати текстовий файл, і натисніть Kutools Plus > Імпорт-експорт > Вставити файл у курсор. Дивіться знімок екрана:
doc імпортувати текстові файли з папки 3

2. Потім з’явиться діалогове вікно, натисніть перегорнути щоб відобразити Виберіть файл щоб вставити в діалогове вікно положення курсора комірки, виберіть наступний Текстові файли зі спадного списку, а потім виберіть текстовий файл, який потрібно імпортувати. Дивіться знімок екрана:
doc імпортувати текстові файли з папки 4

3. клацання відкритий > Ok, а вказаний текстовий файл було вставлено в позицію курсора, див. знімок екрана:
doc імпортувати текстові файли з папки 5


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2019 та 365. Підтримує всі мови. Простота розгортання на вашому підприємстві чи в організації. Повна функція 30-денної безкоштовної пробної версії. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Tom · 4 months ago
    The code works but imports each text file to a new tab in the workbook.  Any idea where in the code this could be changed to import the new text file on the same worksheet below the data from the last text file?
  • To post as a guest, your comment is unpublished.
    sadiashahbaz57 · 6 months ago
    i need you help i dont have any idea vba excel i want to import multiple text file like 13000. the text file name same as the cell for example (c1=112 so the text file name is also 112) mean the text file 112 is import the c112.
  • To post as a guest, your comment is unpublished.
    sadiashahbaz57 · 6 months ago
    0

    i need you help i dont have any idea vba excel i want to import multiple text file like 13000. the text file name same as the cell for example (c1=112 so the text file name is also 112) mean the text file 112 is import the c112.
  • To post as a guest, your comment is unpublished.
    Martinho · 1 years ago
    Hi, my code runs but only imports the first file. It says there was a method error for copy. The debugger highlights the following line of code. Any ideas?


    xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
    • To post as a guest, your comment is unpublished.
      Lars · 11 months ago
      Hey Martinho,
      I had the same Problem and solved it by changing this line:
      Set xToBook = ThisWorkbook
      to
      Set xToBook = ActiveWorkbook
      Maybe this helps.


  • To post as a guest, your comment is unpublished.
    Heles · 1 years ago
    thanks a lot
    did the job on office 2007 excel
  • To post as a guest, your comment is unpublished.
    Siri_2 · 1 years ago
    is there any chance for taking sheet names only certain part from txt file names?

    as per above code the entire sheet name has been taking.
  • To post as a guest, your comment is unpublished.
    302del · 2 years ago
    Hello, how do you modify this code to insert *.txt files in order: 1,2,3,4,5,6,7,8,9,10,11, etc. Currently code inserts files as follows:1,10,11,12,13,14,15,16,17,18,19,2,20,21, etc. Thanks!
  • To post as a guest, your comment is unpublished.
    pooja · 2 years ago
    hi i want to prevent removing preceding zero's in excel.

    i have tried below code but it is not working


    Sub Test()
    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
    Dim j As Long
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder"
    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))
    ActiveSheet.Cells.NumberFormat = "@" 'This is to make excel in text format before pasting the text file data
    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
    End Sub
    • To post as a guest, your comment is unpublished.
      Sunny · 2 years ago
      Pooja, you can try the Remove Leading Zeros function of Kutools for Excel to remove all leading zeros from selection after importing.
      • To post as a guest, your comment is unpublished.
        pooja · 2 years ago
        but I don't want to remove. I want to prevent from removing preceding zero's.
        • To post as a guest, your comment is unpublished.
          Sunny · 2 years ago
          If you want to keep the leading zeros, you can format them as text format by Cell Format.
  • To post as a guest, your comment is unpublished.
    Harsh · 3 years ago
    How would you delete the sheets in vba code if you dont want duplicates on re-executing the module?
    • To post as a guest, your comment is unpublished.
      Sunny · 2 years ago
      Sorry, Harsh, just be carefull to avoid repeatly importing.
  • To post as a guest, your comment is unpublished.
    John · 3 years ago
    Hi, my code runs but only imports the first file. It says there was a method error for copy. The debugger highlights the following line of code. Any ideas?


    xWb.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
    • To post as a guest, your comment is unpublished.
      katie · 2 years ago
      I have the same problem, any solutions found?
      • To post as a guest, your comment is unpublished.
        Madeline · 7 months ago
        Hey katie, 
        I know that your comment is pretty old, but I faced the same problem and fixed it this way:
        The module has to be inserted in a subfolder of the active .xlsx project. I made the mistake of copying the code into a subfolder of my PERSONAL.XLSB where I usually store my macros and it does with my other macros, but not with this one.
  • To post as a guest, your comment is unpublished.
    albeer.mayez@gmail.com · 3 years ago
    The Code is very helpful, it is the only code that i found which gets txt files in bulk the fix that i need on it is also what Joyce and Davinder are after.
    It is to extract the .txt files and paste them all under each other in a specific column lets say column 'N'.

    Also, need to know if it will be possible to add an "if condition" for the .txt files imported to be as follow.
    if the .txt files start with letter 'A' then to be pasted on 'sheet 1' starting with cell 'N2'
    and if the .txt files start with letter 'B' then paste on 'Sheet 2' starting with cell 'N2'
    else MsgBox to be "Unrecognised .txt file purpose".

    thank you in advance
    • To post as a guest, your comment is unpublished.
      Sunny · 3 years ago
      Sorry, my hands are tied
    • To post as a guest, your comment is unpublished.
      albeer.mayez@gmail.com · 3 years ago
      I have this code worked for me but still, I need to change some in it.

      *I want it to paste on the same sheet without opening a new sheet then copy it as it takes longer time.

      *need to insert a conditional if for txt files imported to be pasted on sheet 1 if it starts with letter A and imported to Sheet 2 if it starts with letter B


      Sub testcopy3()
      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
      Dim LastRow As Long
      Dim Rng As Range
      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
      Range("N2").Select
      Set xToBook = ThisWorkbook
      If xFiles.Count > 0 Then
      For i = 1 To xFiles.Count
      Set xWb = Workbooks.Open(xStrPath & xFiles.Item(i))
      xWb.Activate
      'Selecting and copying the txt data
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Copy
      xToBook.Activate
      ActiveSheet.Paste
      Selection.End(xlDown).Offset(1).Select
      On Error Resume Next
      On Error GoTo 0
      xWb.Close False
      Next
      End If
      End Sub
  • To post as a guest, your comment is unpublished.
    Joyce · 4 years ago
    When I run the module as given, it adds each .txt file as a new sheet, not as a new line to the existing sheet. Is there a way to achieve that as the output instead of new sheets for each .txt file?
    • To post as a guest, your comment is unpublished.
      Sunny · 4 years ago
      Do you mean to combine all text file to one sheet?
      • To post as a guest, your comment is unpublished.
        Davinder · 3 years ago
        Yes this is what I want as well.
  • To post as a guest, your comment is unpublished.
    DF Max · 4 years ago
    how to do if my Txt file contain delimited using comma?
    • To post as a guest, your comment is unpublished.
      Sunny · 4 years ago
      You can use Find and Replace fuctuon to replace the comma with space first, and the apply one of above method to convert it to Excel file.
      • To post as a guest, your comment is unpublished.
        Robin · 4 years ago
        Isn't there a way to change this in the code? I'd have to do this with 130 files
        • To post as a guest, your comment is unpublished.
          Igor · 2 years ago
          Same question
  • To post as a guest, your comment is unpublished.
    P B Rama Murty · 4 years ago
    Sub Test()
    'UpdatebyExtendoffice6/7/2016
    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
    End Sub

    this code is helping but I want

    tab, semi colon, space true how to do this please help me
    • To post as a guest, your comment is unpublished.
      Sunny · 4 years ago
      Do you want to keep the space(delimiters) after converting the text files to sheets?
      • To post as a guest, your comment is unpublished.
        farzaneh · 4 years ago
        that is my problem too, this code is true. but after convert text files to excel, it doesn't keep the delimiters.
        • To post as a guest, your comment is unpublished.
          Sunny · 4 years ago
          Could you upload the text file and the result you want for me?
          • To post as a guest, your comment is unpublished.
            Des · 3 years ago
            I have the same problem. The txt files are all in separate sheets and the code ignores the space between the two columns
            • To post as a guest, your comment is unpublished.
              Sunny · 3 years ago
              Hello, Des and P B Rama Murty, the below code can split data into columns based on space or tab while importing text file to sheets. You can have a try.

              Sub ImportTextToExcel()
              'UpdatebyExtendoffice20180911
              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
              Dim xIntRow As Long
              Dim xFNum, xFArr As Long
              Dim xStrValue As String
              Dim xRg As Range
              Dim xArr
              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
              On Error Resume Next
              Application.ScreenUpdating = False
              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)

              ActiveSheet.Name = xWb.Name

              xWb.Close False
              xIntRow = ActiveCell.CurrentRegion.Rows.Count
              For xFNum = 1 To xIntRow
              Set xRg = ActiveSheet.Range("A" & xFNum)
              xArr = Split(xRg.Text, " ")
              If UBound(xArr) > 0 Then
              For xFArr = 0 To UBound(xArr)
              If xArr(xFArr) <> "" Then
              xRg.Value = xArr(xFArr)
              Set xRg = xRg.Offset(ColumnOffset:=1)
              End If
              Next
              End If
              Next
              Next
              End If
              Application.ScreenUpdating = True
              End Sub
              • To post as a guest, your comment is unpublished.
                jayant · 6 months ago
                What changes need to be done if I need tot data into columns based on comma?
              • To post as a guest, your comment is unpublished.
                Jayant · 6 months ago
                What changes needed if want to split data into columns based on comma