PDA

View Full Version : Solved: VBA to import files to sheets



JimS
07-09-2009, 01:42 PM
I have found this code that allows the user to select multiple xls files from a single folder and import them to individual sheets of a workbook. This code works perfect, except I need it to import the files into the Workbook that contains this macro. The way it works now is it opens a new workbook and then imports the xls files into the new workbook. Can this be modified so that the files will be imported to the sheets of the active workbook?
The reason is that I want to import into the active workbook is because I'm using a "template" that has an exsisting sheet in it.



Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String

On Error GoTo ErrHandler
Application (http://excel.tips.net/Pages/T003148_Importing_Multiple_Files_to_a_Single_Workbook.html).ScreenUpdating = False

sDelimiter = "|"

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

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
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:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, 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:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter
End With
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

mdmackillop
07-09-2009, 03:12 PM
Change this section

If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
Set wkbAll = ActiveWorkbook
x = 1
Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy After:=wkbAll.Sheets(wkbAll.Sheets.Count)
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
x = x + 1

JimS
07-09-2009, 04:58 PM
I get a "No Data was Selected to parse" error message and it only copies 1 file.

Any ideas?

Thanks...

mdmackillop
07-09-2009, 11:37 PM
You're getting one sheet only because the code errors. The problem relates to this line

wkbAll.Worksheets(x).Columns("A:A").TextToColumns _


I think this should fix it.

wkbAll.Worksheets(wkbAll.Sheets.Count).Columns("A:A").TextToColumns _

JimS
07-10-2009, 06:12 AM
That looks like that was it, THANKS...