Combine workstheets of multipel workbooks into one workbook using a macro

S

Sam Commar

I was provided the following macro to combine multiple workbook sheets in
one sheet however I am getting the error -"Run time error 424" Object
required on the lines below

newbk.SaveAs Filename:=sf & "\" & _
sf.Name & ".xls"

I would really apprceiate if someone can guide me on what the fix of this
error might be.


---------

Please see complete macro below.



The macro below will search each folder in the Root directory and combine
all
sheets in all workbook into a single workbook. then it will save the new
book in the same directory using the parent folders name.


Sub Combinebooks()

Root = "c:\Temp"


Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(Root)

For Each sf In folder.subfolders
First = True
FName = Dir(sf & "\*.xls")
Do While FName <> ""
Set bk = Workbooks.Open(Filename:=sf & "\" & FName)
For Each sht In bk.Sheets
If First = True Then
sht.Copy
Set newbk = ActiveWorkbook
First = False
Else
With newbk
sht.Copy _
after:=.Sheets(.Sheets.Count)
End With
End If
Next sht
bk.Close savechanges:=False
FName = Dir()
Loop
newbk.SaveAs Filename:=sf & "\" & _
sf.Name & ".xls"
newbk.Close
Next sf

End Sub
 
D

Dave Peterson

Sub Combinebooks()

Root = "c:\Temp"


Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(Root)

For Each sf In folder.subfolders
First = True
set newbk = nothing '<-- added
FName = Dir(sf & "\*.xls")
Do While FName <> ""
Set bk = Workbooks.Open(Filename:=sf & "\" & FName)
For Each sht In bk.Sheets
If First = True Then
sht.Copy
Set newbk = ActiveWorkbook
First = False
Else
With newbk
sht.Copy _
after:=.Sheets(.Sheets.Count)
End With
End If
Next sht
bk.Close savechanges:=False
FName = Dir()
Loop

if newbk is nothing then
'do nothing or maybe a msgbox
'msgbox "Nothing found in this folder: " & sf
else
newbk.SaveAs Filename:=sf & "\" & _
sf.Name & ".xls"
newbk.Close
end if
Next sf

End Sub
 
S

Sam Commar

Dave

Thanks for the info. I did the modification and although this did not give
me the error it did not seem to do anything.
The macro references C:\temp

Do the excel files have to be in the C:\temp folder.

Also I am using Excel 2007

Thanks

S Commar
 
D

Dave Peterson

Try uncommenting this line:
'msgbox "Nothing found in this folder: " & sf

Maybe it'll give you an idea what's going wrong.
 
S

Sam Commar

Dave

Thanks very much for your help. When I uncomment it said nothing found in
c:\temp

So then I tried changing the c:\temp to my file directory and it did nothing
and no message.

Then I created a directory called Exce in my C:\temo direcotry and moved my
excel files to the c:\temp\Excel direcotry and it made a new file called
Excel with all the items.


How can I change the Root directory from Root = "c:\Temp" to Root =
"C:\Clients\Ron\Complete Sets\UNIT PERFSS-all units 09-03-31 22-23-43"

It does not give my any error message and does not do anything


Thanks again for your guidance

S Commar
 
D

Dave Peterson

You changed this line:
Root = "c:\Temp"
right?

If yes, then I bet there were no *.xls files in that folder (and subfolders) or
you typed the wrong folder name.



Sam said:
Dave

Thanks very much for your help. When I uncomment it said nothing found in
c:\temp

So then I tried changing the c:\temp to my file directory and it did nothing
and no message.

Then I created a directory called Exce in my C:\temo direcotry and moved my
excel files to the c:\temp\Excel direcotry and it made a new file called
Excel with all the items.

How can I change the Root directory from Root = "c:\Temp" to Root =
"C:\Clients\Ron\Complete Sets\UNIT PERFSS-all units 09-03-31 22-23-43"

It does not give my any error message and does not do anything

Thanks again for your guidance

S Commar
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top