Macor
 

I have this macro to pull multiple excel files into one sheet, it works fine.
However it puts all the files into a new workbook. I will like it to add the
files the workbook in which I run the macro from. Can anyone helop me out?

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

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="excel 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:=True, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
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:=False, _
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=False, 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


--

Jake

Macor
 

try:

wkbTemp.Sheets(1).Copy Befo=ThisWorkbook.Sheets(1)

"JakeShipley2008" wrote:

I have this macro to pull multiple excel files into one sheet, it works fine.
However it puts all the files into a new workbook. I will like it to add the
files the workbook in which I run the macro from. Can anyone helop me out?

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

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="excel 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:=True, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
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:=False, _
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=False, 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


--

Jake

Macor
 

Thanks Toppers, but when I do that it gives me an "Object" error
--
Jake


"Toppers" wrote:

try:

wkbTemp.Sheets(1).Copy Befo=ThisWorkbook.Sheets(1)

"JakeShipley2008" wrote:

I have this macro to pull multiple excel files into one sheet, it works fine.
However it puts all the files into a new workbook. I will like it to add the
files the workbook in which I run the macro from. Can anyone helop me out?

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

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="excel 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:=True, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
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:=False, _
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=False, 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


--

Jake

Macor
 

Jake
I think your problem might be with the following statement
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook

I may be wrong but if you are copying from 1 workbook, that is the active
workbook
You are setting a reference to the active workbook and then closing the
active workbook

Again I might be very wrong here. A quick way to check would be using the
following
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False) <--- Change wkbTemp to ActiveWorkbook.Close

and see what happens?

HTH


"JakeShipley2008" wrote:

I have this macro to pull multiple excel files into one sheet, it works fine.
However it puts all the files into a new workbook. I will like it to add the
files the workbook in which I run the macro from. Can anyone helop me out?

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

On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = ","

FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="excel 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:=True, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
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:=False, _
Tab:=True, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=False, 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


--

Jake