combining 2+ wkbks into 1. Code needs tweaking please

[ian123]

I have been using the following code to combine sheets from workbook
saved in a folder called "MyData" andit has been working fine.

However today i am being told that "Method 'Copy' of object 'Sheets
failed" and the lines

wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)

are highlighted as the problem. I can't figure out whats going on an
how to fix it. Can anyone help please (I have included the complet
code below...)


Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
sPath = "C:\MyData\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
wkbk.Worksheets.Copy After:=ThisWorkbook. _
Worksheets(ThisWorkbook.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End Su

 

[Tom Ogilvy]

If it worked before and you haven't changed anything, then generally, the
code doesn't need tweaking. What has changed? How many sheets are in the
the workbook containing the code (where you are copying/placing the sheets
from Data1, Data2 and Data3?

What version of Excel are you using?

If you place the code in a new workbook and run it, does it work again?

 

[ian123]

Tom,

Thanks for the suggestions - i cut and paste the formula into a ne
workbook and new it works fine without any 'tweaking'.

I'm bamboozled as to why it didn't work in the first book but at leas
its fixed now! Many thank

 

[ian123]

Tom,

Still having problems...

If i copy the code, delete the macro from personal.xls, open a ne
workbook, right click on sheet1 name tag and paste the code into th
view code sheet - everything works fine.

If i save the code into personal.xls, and attempt to run from there
am getting the run time error outlined above.

Any idea how i can fix this - i need to save this in personal.xls

Many thanks for your time and consideratio

 

[Tom Ogilvy]

If you put the code in personal.xls, it will try to copy the sheets from the
other workbooks into personal.xls. I doubt that is what you want. Where do
you want the sheets copied?

This will copy the sheet to the activeworkbook at the time the macro is run.

Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim wkbk1 as Workbook
set wkbk1 = Activeworkbook
sPath = "C:\MyData\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
wkbk.Worksheets.Copy After:=wkbk1. _
Worksheets(wkbk1.Worksheets.Count)
wkbk.Close SaveChanges:=False
Next
End Sub

 

[ian123]

Tom,

What you describe in your latest response is exactly what i require -
however on running the macro i am told "Run time error '424': Object
Required"

Again the same two problem lines are highlighted!

I'm figuring that this is easily solved - can you explain how please?

Many thanks

 

[Tom Ogilvy]

Can't fix what isn't broken. Copied the code out of my email, pasted it in
personal.xls and ran it with no problems.

 

[ian123]

mmm interesting... leave it with me while i pull out my hair and curse
my computer!!!!

Cheers for your time and efforts

 

[Tom Ogilvy]

You do have an empty/new workbook as the activeworkbook when you run the
macro? This would be the workbook where you want to copy the sheets to. It
doesn't have to be new or empty (in fact it must have one sheet in it). But
if you have no visible workbooks then there is no place to copy the sheets.
If you need the macro to create a workbook on the first copy, it can be
modified to do that.

Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim wkbk1 as Workbook
set wkbk1 = Activeworkbook
sPath = "C:\MyData\"
varr = Array("Data1.xls", "Data2.xls", "Data3.xls")
For i = LBound(varr) To UBound(varr)
Set wkbk = Workbooks.Open(sPath & varr(i))
if i = lbound(varr) then
wkbk.Worksheets.copy
set wkbk1 = ActiveWorkbook
else
wkbk.Worksheets.Copy After:=wkbk1. _
Worksheets(wkbk1.Worksheets.Count)
End if
wkbk.Close SaveChanges:=False
Next
End Sub

 

[ian123]

Tom,

Many thanks, have now got it working as desired. Don't know quite what
the problem was but starting over with your info solved it!

One final question if i may - is it possible to modify the code to
allow it to pick up any excel files in the Data folder, regardless of
the title - i tried replacing the file name with *.xls but my idea was
rejected by excel!!!

Once again, thanks very much for your help

 

[ian123]

Tom,

Thanks for your continued efforts - thanks to you i have now solved
that problem. Is it possible to modify to allow any workbook to be
copied without having to specify a name? I'm thinking that i'd have to
include something along the lines of *.xls at some point but my efforts
so far have proved fruitless!!!

MAny thanks

 

[Tom Ogilvy]

Sub GetSheets()
Dim sPath As String, i As Long
Dim varr As Variant
Dim wkbk As Workbook
Dim wkbk1 As Workbook
Set wkbk1 = ActiveWorkbook
Dim sName As String
sPath = "C:\MyData\"
ReDim varr(1 To 1)
sName = Dir(sPath & "*.xls")
i = 1
Do While sName <> ""
varr(i) = sName
i = i + 1
ReDim Preserve varr(1 To i)
sName = Dir
Loop
For i = LBound(varr) To UBound(varr) - 1
Set wkbk = Workbooks.Open(sPath & varr(i))
If i = LBound(varr) Then
wkbk.Worksheets.Copy
Set wkbk1 = ActiveWorkbook
Else
wkbk.Worksheets.Copy After:=wkbk1. _
Worksheets(wkbk1.Worksheets.Count)
End If
wkbk.Close SaveChanges:=False
Next
End Sub

 

[ian123]

Cheers mate, thats perfect! Thanks very much for your considerabl
effort in helpingme out