Merge multiple workbooks into one.

[Mrs. Robinson]

I am using this macro to merge 50+ workbooks with 1 sheet per wb, into one
workbook. I get this error message: Method 'Move' of object 'Sheets'
failed. Can you help? Thanks...

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer

On Error GoTo ErrHandler
Application.ScreenUpdating = False

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

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

x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open FileName:=FilesToOpen(x)
Sheets().Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

 

[JP]

My guess is that you have an unqualified reference. Try setting an
object reference to the newly opened workbook, then fully qualifying
the Move method.

Dim wb As Excel.Workbook
Set wb = Workbooks.Open FileName:=FilesToOpen(x)
wb.Sheets.Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)

--JP

 

[Luke M]

Since your workbooks only have 1 worksheet, moving the sheet would create a
workbook with no sheets (not possible). To get around this, try changing this
line:

Sheets().Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)

to

Sheets().Copy After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)

the effect will be similar, the one difference being that the old workbook
will still contain a copy of the worksheet.

 

[john]

made small change to your code - see if does what you want.

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
Dim wb As Workbook

On Error GoTo ErrHandler
Application.ScreenUpdating = False

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

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

x = 1
While x <= UBound(FilesToOpen)
Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
wb.Sheets(1).Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
x = x + 1

wb.Close False
Wend

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

 

[Mrs. Robinson]

For Luke's solution, I get the same error message except it readsmethod
'Move'...failed

John's solution gives me a "Move method of Worksheet class failed" message.

JP's solution - there's some sort of error in this line: Set wb =
Workbooks.Open FileName:=FilesToOpen(x)

 

[john]

try changing this line:

wb.Sheets(1).Move After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)

for this

wb.Sheets(1).Copy After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)

 

[Mrs. Robinson]

I get copy method of worksheet class failed error.

 

[JP]

My bad, Luke is right, you can't move all the sheets out of a
workbook.

Here's another suggestion: start x at zero, I believe LBound
(FilesToOpen) should start at zero. Otherwise I'm missing something. I
haven't been actually testing the code.

--JP

 

[Mrs. Robinson]

that didn't work either.

My bad, Luke is right, you can't move all the sheets out of a
workbook.

Here's another suggestion: start x at zero, I believe LBound
(FilesToOpen) should start at zero. Otherwise I'm missing something. I
haven't been actually testing the code.

--JP

 

[JP]

I put four one-sheet workbooks on my desktop, then created a new
workbook and ran the following macro (basically an amalgam of the
edits Luke and John already posted). I selected the four (closed)
workbooks, and it copied the sheets from each workbook into the
current workbook.

Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
Dim wb As Excel.Workbook

On Error GoTo ErrHandler
Application.ScreenUpdating = False


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

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

x = 1
While x <= UBound(FilesToOpen)
Set wb = Workbooks.Open(Filename:=FilesToOpen(x))
wb.Sheets.Copy After:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
wb.Close False
x = x + 1
Wend

ExitHandler:
Application.ScreenUpdating = True
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub


--JP

 

[Ron de Bruin]

Try
http://www.rondebruin.nl/fso.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

 

[Mrs. Robinson]

I'm not having any luck with any of these solutions. I"m going to keep
plugging away at it. Thanks for all the suggestions!

 

[JP]

Can you be more specific? Are the 50 workbooks closed? What line does
the code fail on? I ran it with four workbooks and it worked, so I'm
confused. Can you try it with just a few workbooks, or are you trying
it with all 50 workbooks each time?

--JP