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
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