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

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

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

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

Ось код 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 , щоб відобразити діалогове вікно та виберіть папку, яка містить текстові файли, які потрібно імпортувати. Дивіться знімок екрана:

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

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

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

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

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

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

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

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

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

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

Детальніше ... Завантажити безкоштовно... Придбати ...

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

Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!

Детальніше ... Завантажити безкоштовно... Придбати ...

35 Comments
Login

Sort by Newest
- Best
- Popular
- Newest
- Oldest

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?
- Reply
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.
- Reply
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.
- Reply
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)
- Reply
- 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.
  
  Reply
To post as a guest, your comment is unpublished.
Heles · 1 years ago
thanks a lot
did the job on office 2007 excel
- Reply
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.
- Reply
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!
- Reply
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
- Reply
- 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.
  
  Reply
  
  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.
  
  Reply
  
  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.
  
  Reply
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?
- Reply
- To post as a guest, your comment is unpublished.
  Sunny · 2 years ago
  
  Sorry, Harsh, just be carefull to avoid repeatly importing.
  
  Reply
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)
- Reply
- To post as a guest, your comment is unpublished.
  katie · 2 years ago
  
  I have the same problem, any solutions found?
  
  Reply
  
  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.
  
  Reply
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
- Reply
- To post as a guest, your comment is unpublished.
  Sunny · 3 years ago
  
  Sorry, my hands are tied
  
  Reply
- 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
  
  Reply
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?
- Reply
- To post as a guest, your comment is unpublished.
  Sunny · 4 years ago
  
  Do you mean to combine all text file to one sheet?
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Davinder · 3 years ago
  
  Yes this is what I want as well.
  
  Reply
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?
- Reply
- 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.
  
  Reply
  
  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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  Igor · 2 years ago
  
  Same question
  
  Reply
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
- Reply
- 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?
  
  Reply
  
  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.
  
  Reply
  
  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?
  
  Reply
  
  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
  
  Reply
  
  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
  
  Reply
  
  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?
  
  Reply
  
  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
  
  Reply

Увійти в свій акаунт

Скидання пароля