Import multiple text files to separated sheets onto current workbook

L

llbac

New Member
Joined
Jul 20, 2023
Messages
30
Office Version
  1. 365
Platform
  1. Windows
Hi everyone!

I got a VBA code that can work successfully to import multiple text files to separated sheets.
However, it creates a new workbook, say Book1, while I expect to load all new imported sheets to the current workbook which I am running this VBA code.
So, I hope someone could take a look on the codes and change where it is needed to meet this requirement.
Thank you very much!

VBA 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:=True, 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:=True, Space:=True, _
              Other:=False, OtherChar:=sDelimiter
                
        End With

        x = x + 1
    Wend
    Application.ScreenUpdating = True
End Sub
 

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
llbac said:
Hi everyone!

I got a VBA code that can work successfully to import multiple text files to separated sheets.
However, it creates a new workbook, say Book1, while I expect to load all new imported sheets to the current workbook which I am running this VBA code.
So, I hope someone could take a look on the codes and change where it is needed to meet this requirement.
Thank you very much!

VBA 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:=True, 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:=True, Space:=True, _
              Other:=False, OtherChar:=sDelimiter
               
        End With

        x = x + 1
    Wend
    Application.ScreenUpdating = True
End Sub
Click to expand...
It is this line that creates a new workbook:

wkbTemp.Sheets(1).Copy
Click to expand...

What format are the text files in?

Can you post using XL2BB a sample of the data?
 
Upvote 0
Herakles said:
It is this line that creates a new workbook:



What format are the text files in?

Can you post using XL2BB a sample of the data?
Click to expand...

I am not quite sure that I understand your question correctly.
After importing, the data will be mostly number or text.
Is that related with the importing process?

As I mentioned, this code worked well, the problem is that it creates a new workbook.
I created myself an excel template with a sheet named "Master", then I assigned this macro to a button in "Master" sheet.
I expect that after clicking the button it will import all text files to separated sheets onto my current workbook after the sheet "Master".

Hope to hear from you!
 
Upvote 0
Here is a macro that will import multiple CSV files into you open and active Workbook.
Sheet names will be the file name (without path information).
You might be able to remove some of the parameter settings assuming the default values will work for your source files.
The macro was created by recording the import of a comma delimited file via the Data->From Text (and following dialog responses)

I hope you can use this.

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
'
  Dim FilesToOpen
  Dim x, tmp
'
  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"
      Exit Sub
  End If
    
  For Each x In FilesToOpen
    ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & x, Destination:=Range("$A$1"))
'        .CommandType = 0
        tmp = Mid(x, InStrRev(x, "\") + 1)
        .Name = Mid(tmp, 1, Len(tmp) - 4)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
  Next
  ActiveWindow.SmallScroll Down:=0
End Sub
 
Upvote 0
Bosquedeguate said:
Here is a macro that will import multiple CSV files into you open and active Workbook.
Sheet names will be the file name (without path information).
You might be able to remove some of the parameter settings assuming the default values will work for your source files.
The macro was created by recording the import of a comma delimited file via the Data->From Text (and following dialog responses)

I hope you can use this.

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
'
  Dim FilesToOpen
  Dim x, tmp
'
  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"
      Exit Sub
  End If
   
  For Each x In FilesToOpen
    ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & x, Destination:=Range("$A$1"))
'        .CommandType = 0
        tmp = Mid(x, InStrRev(x, "\") + 1)
        .Name = Mid(tmp, 1, Len(tmp) - 4)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
  Next
  ActiveWindow.SmallScroll Down:=0
End Sub
Click to expand...
Dear @Bosquedeguate , your code works like a charm!
However, could you do me a favor that keeps the original file names after importing?
Currently, all the new sheet has been named as Sheet1, Sheet2, Sheet3 etc.
I would like to retain the original file names to track what are imported.
Thank you very much!
 
Upvote 0
I added code to rename the new sheet to the file name of the imported file (without file extension). Will that work for you?

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
'
  Dim FilesToOpen
  Dim x, tmp
'
  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"
      Exit Sub
  End If
   
  For Each x In FilesToOpen
    ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
    tmp = Mid(x, InStrRev(x, "\") + 1)
    ActiveSheet.Name = Mid(tmp, 1, Len(tmp) - 4)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & x, Destination:=Range("$A$1"))
'        .CommandType = 0
        .Name = Mid(tmp, 1, Len(tmp) - 4)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
  Next
  ActiveWindow.SmallScroll Down:=0
End Sub
 
Upvote 0
Solution
Bosquedeguate said:
I added code to rename the new sheet to the file name of the imported file (without file extension). Will that work for you?

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
'
  Dim FilesToOpen
  Dim x, tmp
'
  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"
      Exit Sub
  End If
  
  For Each x In FilesToOpen
    ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
    tmp = Mid(x, InStrRev(x, "\") + 1)
    ActiveSheet.Name = Mid(tmp, 1, Len(tmp) - 4)
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & x, Destination:=Range("$A$1"))
'        .CommandType = 0
        .Name = Mid(tmp, 1, Len(tmp) - 4)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
  Next
  ActiveWindow.SmallScroll Down:=0
End Sub
Click to expand...
It worked perfectly now!
Thank you so much!
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Automatically import .txt files into separate sheets in Excel
Replies
1
Views
724
John_w
J
F
  • Solved
Delimiters in VBA has different result than manual
Replies
7
Views
92
Peter_SSs
Peter_SSs
E
  • Solved
Force Excel 2019 VBA to import multiple txt file to existing sheet & not seperate wk.book / wk.sheets
Replies
1
Views
595
Domenic
D
D
  • Question Question
VBA optimization advice
Replies
3
Views
401
bobsan42
bobsan42
J
  • Question Question
Text to Columns in Macro
2
Replies
10
Views
630
Alex Blakenburg
A

Forum statistics

Threads
1,223,883
Messages
6,175,167
Members
452,615
Latest member
bogeys2birdies

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