Import Multiple Text Files from a folder to multiple worksheets

V

vincentzack

New Member
Joined
Jul 2, 2016
Messages
8
I need to import multiple text files (all the same format) into an excel spreadsheet. The text files are saved in a folder, e.g. C:\Test. The path can be changed in the excel (like the attached excel, worksheet("Master"), cells (B1))

I want to import some of the text files from the folder (not import all) to separate worksheet. For example: import BEAMA.txt, then excel will have a sheet called BEAMA".

I only have the code to import the text file one by one. However, I need to import 50 nos. of text file out of 200. Could anyone help?

Code: 
[/COLOR]
[COLOR=#333333]Sub ImportData()[/COLOR]
[COLOR=#333333]Dim txtFileNameAndPath As String[/COLOR]
[COLOR=#333333]Dim ImportingFileName As String, ImportingFileName2 As String[/COLOR]
[COLOR=#333333]Dim SheetName As Worksheet[/COLOR]
[COLOR=#333333]Dim fd As Office.FileDialog[/COLOR]


[COLOR=#333333]Set fd = Application.FileDialog(msoFileDialogFilePicker)[/COLOR]

[COLOR=#333333]With fd[/COLOR]
[COLOR=#333333]'Enable this option if you want the use to be able to select multiple files[/COLOR]
[COLOR=#333333].AllowMultiSelect = False[/COLOR]

[COLOR=#333333]'This sets the title of the dialog box.[/COLOR]
[COLOR=#333333].Title = "Please select the file."[/COLOR]

[COLOR=#333333]'Sets the associated filters for types of files[/COLOR]
[COLOR=#333333].Filters.Clear[/COLOR]
[COLOR=#333333].Filters.Add "txt", "*.txt"[/COLOR]
[COLOR=#333333].Filters.Add "All Files", "*.*"[/COLOR]

[COLOR=#333333]' Show the dialog box. If the .Show method returns True, the[/COLOR]
[COLOR=#333333]' user picked at least one file. If the .Show method returns[/COLOR]
[COLOR=#333333]' False, the user clicked Cancel.[/COLOR]
[COLOR=#333333]If .Show = True Then[/COLOR]
[COLOR=#333333]txtFileNameAndPath = .SelectedItems(1)[/COLOR]
[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]MsgBox "Please start over. You must select a file to import"[/COLOR]
[COLOR=#333333]'You don't want the sub continuing if there wasn't a file selected[/COLOR]
[COLOR=#333333]Exit Sub[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]End With[/COLOR]

[COLOR=#333333]'Extracts only the file name for reference later[/COLOR]
[COLOR=#333333]ImportingFileName = Right(txtFileNameAndPath, _[/COLOR]
[COLOR=#333333]Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))[/COLOR]
[COLOR=#333333]'Nneed to be on the active worksheet for the below code to work[/COLOR]
[COLOR=#333333]ImportingFileName2 = Left(ImportingFileName, Len(ImportingFileName) - 4)[/COLOR]
[COLOR=#333333]ThisWorkbook.Sheets.Add.Name = ImportingFileName2[/COLOR]
[COLOR=#333333]Worksheets(ImportingFileName2).Activate[/COLOR]
[COLOR=#333333]With ActiveSheet.QueryTables.Add(Connection:= _[/COLOR]
[COLOR=#333333]"TEXT;" & txtFileNameAndPath _[/COLOR]
[COLOR=#333333], Destination:=Worksheets(ImportingFileName2).Range("$A2"))[/COLOR]
[COLOR=#333333].Name = "ImportingFileName"[/COLOR]
[COLOR=#333333].FieldNames = True[/COLOR]
[COLOR=#333333].RowNumbers = False[/COLOR]
[COLOR=#333333].FillAdjacentFormulas = False[/COLOR]
[COLOR=#333333].PreserveFormatting = True[/COLOR]
[COLOR=#333333].RefreshOnFileOpen = False[/COLOR]
[COLOR=#333333].RefreshStyle = xlInsertDeleteCells[/COLOR]
[COLOR=#333333].SavePassword = False[/COLOR]
[COLOR=#333333].SaveData = True[/COLOR]
[COLOR=#333333].AdjustColumnWidth = True[/COLOR]
[COLOR=#333333].RefreshPeriod = 0[/COLOR]
[COLOR=#333333].TextFilePromptOnRefresh = False[/COLOR]
[COLOR=#333333].TextFilePlatform = 950[/COLOR]
[COLOR=#333333].TextFileStartRow = 1[/COLOR]
[COLOR=#333333].TextFileParseType = xlDelimited[/COLOR]
[COLOR=#333333].TextFileTextQualifier = xlTextQualifierDoubleQuote[/COLOR]
[COLOR=#333333].TextFileConsecutiveDelimiter = False[/COLOR]
[COLOR=#333333].TextFileTabDelimiter = True[/COLOR]
[COLOR=#333333].TextFileSemicolonDelimiter = False[/COLOR]
[COLOR=#333333].TextFileCommaDelimiter = False[/COLOR]
[COLOR=#333333].TextFileSpaceDelimiter = False[/COLOR]
[COLOR=#333333].TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)[/COLOR]
[COLOR=#333333].TextFileTrailingMinusNumbers = True[/COLOR]
[COLOR=#333333].Refresh BackgroundQuery:=False[/COLOR]
[COLOR=#333333]End With[/COLOR]
[COLOR=#333333]End Sub[/COLOR][COLOR=#333333]
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Hello,

I regularly use this code to import text files on my work.
You can select as many text files as you want.
It will import each text file and import them into their own sheet.
Naming each sheet with the text files name.

It will also provide deliminator options, since the text files I have import all the data into a single column.
So I have this one set to separate by space in column A.

You can tweak the deliminator choices to your liking or remove them all together.

I hope this helps.

Code: 
Sub Import_Text_Files

Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String


    Application.ScreenUpdating = False


    sDelimiter = "|"


    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")


    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
    End If


    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=True, _
      Other:=False, OtherChar:="|"
    x = x + 1


    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=True, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=True, _
              Other:=False, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here's the code without the delimited function.
It simply imports every text file selected, and puts them into their own workseet.

Code: 
Sub Import_Text_To_Sheets()

    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)

    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

        End With
        x = x + 1
    Wend

    Application.ScreenUpdating = True

End Sub
 
Last edited:
Upvote 0
Jambi46n2 said:
Here's the code without the delimited function.
It simply imports every text file selected, and puts them into their own workseet.

Code: 
Sub Import_Text_To_Sheets()

    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    Application.ScreenUpdating = False

    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)

    x = x + 1

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)

        End With
        x = x + 1
    Wend

    Application.ScreenUpdating = True

End Sub
Click to expand...

Jambi46n2, Thanks! But I want to import the text files into existing workbook because I have other calculations in the workbook based on the data in the text files. Could you help me?
 
Upvote 0
Try this code and let me know if it worked for you.

Code: 
'
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String


    Application.ScreenUpdating = False


    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")


    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
    End If


    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ThisWorkbook
    wkbTemp.Close (False)


    x = x + 1


    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(ThisWorkbook.Sheets.Count)


        End With
        x = x + 1
    Wend


    Application.ScreenUpdating = True
'
End Sub
 
Upvote 0
Hello, I also have problem with importing multiple text files in Excel. Do you know how to Import files in already existing sheets? I would be very grateful to you if you help me.
 
Upvote 0
This code is excellent and works! Thank you!

Quick question, can you advise how I can incorporate a "Replace" character function into the text file prior to importing?

I'm not familiar with how to incorporate this particular code into the script above. Any help will be appreciated greatly.

Sub TestReplaceTextInFile()
ReplaceTextInFile ThisWorkbook.Path & _
"\ReplaceInTextFile.txt", ",
' replaces all comma space (, ) with no spaces, commas only (,)
End Sub
 
Upvote 0
Jambi46n2 said:
Hello,

I regularly use this code to import text files on my work.
You can select as many text files as you want.
It will import each text file and import them into their own sheet.
Naming each sheet with the text files name.

It will also provide deliminator options, since the text files I have import all the data into a single column.
So I have this one set to separate by space in column A.

You can tweak the deliminator choices to your liking or remove them all together.

I hope this helps.

Code: 
Sub Import_Text_Files

Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String


    Application.ScreenUpdating = False


    sDelimiter = "|"


    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")


    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
    End If


    x = 1
    Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=True, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=True, _
      Other:=False, OtherChar:="|"
    x = x + 1


    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=True, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=True, _
              Other:=False, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend
    Application.ScreenUpdating = True
End Sub
Click to expand...

This code is excellent and works! Thank you!

Quick question, can you advise how I can incorporate a "Replace" character function into the text file prior to importing?

I'm not familiar with how to incorporate this particular code into the script above. Any help will be appreciated greatly.

Sub TestReplaceTextInFile()
ReplaceTextInFile ThisWorkbook.Path & _
"\ReplaceInTextFile.txt", ",
' replaces all comma space (, ) with no spaces, commas only (,)
End Sub
 
Upvote 0
agoretoy said:
This code is excellent and works! Thank you!

Quick question, can you advise how I can incorporate a "Replace" character function into the text file prior to importing?

I'm not familiar with how to incorporate this particular code into the script above. Any help will be appreciated greatly.

Sub TestReplaceTextInFile()
ReplaceTextInFile ThisWorkbook.Path & _
"\ReplaceInTextFile.txt", ",
' replaces all comma space (, ) with no spaces, commas only (,)
End Sub
Click to expand...

This thread has some code you can incorporate for what you need:

https://www.mrexcel.com/forum/excel-questions/510327-vba-find-replace-operation.html
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Question
VBA to import multilpe xml files
Replies
1
Views
42
PippaThePointer
P
J
  • Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
183
John_w
J
L
  • Solved
Importing specific cell data from one workbook to another
Replies
1
Views
377
rlv01
R
H
  • Question
Macro to limit browsing to specific File
Replies
2
Views
231
howard
H
G
  • Solved
Change Macro to import files from hyperlinks
2
Replies
12
Views
426
GarnesGambit
G

Forum statistics

Threads
1,214,948
Messages
6,122,420
Members
449,083
Latest member
Ava19

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top