Merge multiple workbooks into one.

  • Thread starter Thread starter Mrs. Robinson
  • Start date Start date
M

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
 
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
 
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.
 
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
 
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)
 
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)
 
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
 
that didn't work either.

JP said:
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
Click to expand...
 
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
 
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!
 
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
 
Back
Top