提示:其它语言是由 Google 机器翻译的。 你可以访问 English 版本。
登录
x
or
x
x
马上登记
x

or

如何将一个文件夹中的多个文本文件导入到一个工作表中?

例如,在这里您有一个包含多个文本文件的文件夹,您想要做的就是将这些文本文件导入到单个工作表中,如下面的屏幕截图所示。 不是一个接一个地复制文本文件,是否有任何技巧可以将文本文件从一个文件夹快速导入到一个工作表中?

使用VBA将多个文本文件从一个文件夹导入到单个工作表中

使用Kutools for Excel将文本文件导入到活动单元格 好idea3


好导出范围到文件

Kutools for Excel's 导出范围到文件功能 可以导出或保存一个范围来分隔文件
工作簿,pdf,文本,csv或文本。
点击 企业服务 > 进出口 > 导出范围到文件.
doc将单元格范围导出到文件
Office选项卡在Office中启用选项卡式编辑和浏览,使您的工作更轻松......
Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%
  • 重用任何东西: 将最常用或最复杂的公式,图表和其他任何内容添加到您的收藏夹中,并在将来快速重复使用它们。
  • 超过20文本功能: 从文本字符串中提取数字; 提取或删除部分文本; 将数字和货币转换为英语单词...
  • 合并工具:多个工作簿和表格合二为一; 合并多个单元格/行/列而不丢失数据; 合并重复行和总和...
  • 拆分工具:根据价值将数据拆分为多个表格; 一个工作簿到多个Excel,PDF或CSV文件; 一列到多列......
  • 粘贴跳过 隐藏/过滤行; 数和总和 按背景颜色; 创建邮件列表和 通过Cell的价值发送电子邮件...
  • 超级过滤器: 创建高级过滤方案并应用于任何工作表; 排序 按周,日,频率等; 筛选 通过大胆,公式,评论......
  • 超过300强大的功能; 与Office 2007-2019和365一起使用; 支持所有语言; 在您的企业或组织中轻松部署。


这是一个VBA代码,可以帮助您将所有文本文件从一个特定的文件夹导入到新的工作表中。

1。 启用要导入文本文件的工作簿,然后按 Alt + F11键 键启用 Microsoft Visual Basic for Applications 窗口。

2。 点击 插页 > 模块,将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 for Excel在光标处插入文件 效用。

Kutools for Excel, 与超过 120 方便的Excel功能,提高工作效率,节省工作时间。

免费安装 Kutools for Excel,请按照以下步骤操作:

1。 选择要导入文本文件的单元格,然后单击 企业服务 > 进出口 > 在光标处插入文件。 看截图:
doc从文件夹3导入文本文件

2。 然后弹出一个对话框,单击 浏览 显示 选择一个文件 插入单元格光标位置对话框中,接下来选择 文本文件 从下拉列表中选择,然后选择要导入的文本文件。 看截图:
doc从文件夹4导入文本文件

3。 点击 开放 > Ok,指定的文本文件已插入光标位置,请参见屏幕截图:
doc从文件夹5导入文本文件


Kutools for Excel解决了您的大多数问题,并使您的生产率提高了80%

  • 重用: 快速插入 复杂的公式,图表 以及你以前用过的任何东西; 加密单元格 密码; 创建邮件列表 并发送电子邮件...
  • 超级方程式酒吧 (轻松编辑多行文字和公式); 阅读布局 (轻松读取和编辑大量单元格); 粘贴到过滤范围...
  • 合并单元格/行/列 不丢失数据; 分裂细胞含量; 组合重复的行/列...防止重复的细胞; 比较范围...
  • 选择复制或唯一 行; 选择空行 (所有细胞都是空的); 超级查找和模糊查找 在许多工作簿中; 随机选择......
  • 精确复制 多个单元格而不更改公式参考; 自动创建参考 多张表; 插入项目符号,复选框等等......
  • 提取文本,添加文本,按位置删除, 删除空间; 创建和打印分页小计; 在单元格内容和注释之间转换...
  • 超级过滤器 (将过滤方案保存并应用到其他工作表); 高级排序 按月/周/日,频率等; 特殊过滤器 用粗体,斜体......
  • 结合工作簿和工作表; 根据键列合并表; 将数据拆分为多个表格; 批量转换xls,xlsx和PDF...
  • 超过300强大的功能。 支持Office / Excel 2007-2019和365。 支持所有语言。 在您的企业或组织中轻松部署。 全功能30天免费试用。
kte tab 201905

Office选项卡为Office提供选项卡式界面,使您的工作更轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,Publisher,Access,Visio和Project。
  • 在同一窗口的新选项卡中打开并创建多个文档,而不是在新窗口中。
  • 通过50%提高您的工作效率,每天为您减少数百次鼠标点击!
官方底部
Say something here...
symbols left.
You are guest ( Sign Up? )
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.
    302del · 8 days 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 · 8 months 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 · 8 months 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 · 8 months 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 · 7 months 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 · 9 months 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 · 8 months ago
      Sorry, Harsh, just be carefull to avoid repeatly importing.
  • To post as a guest, your comment is unpublished.
    John · 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.
      katie · 18 days ago
      I have the same problem, any solutions found?
  • To post as a guest, your comment is unpublished.
    Albeer Mayez · 1 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 · 1 years ago
      Sorry, my hands are tied
    • To post as a guest, your comment is unpublished.
      Albeer Mayez · 1 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 · 1 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.
    DF Max · 1 years ago
    how to do if my Txt file contain delimited using comma?
    • To post as a guest, your comment is unpublished.
      Sunny · 1 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 · 1 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.
    P B Rama Murty · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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