Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine workstheets of multipel workbooks into one workbook using a macro
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine workstheets of multipel workbooks into one workbook using amacro
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 Sam Commar wrote: 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 -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine worksheets of multiple workbooks into one workbook using a macro
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 "Dave Peterson" wrote in message ... 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 Sam Commar wrote: 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 -- Dave Peterson |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine worksheets of multiple workbooks into one workbook using amacro
Try uncommenting this line:
'msgbox "Nothing found in this folder: " & sf Maybe it'll give you an idea what's going wrong. Sam Commar wrote: 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 "Dave Peterson" wrote in message ... 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 Sam Commar wrote: 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 -- Dave Peterson -- Dave Peterson |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine worksheets of multiple workbooks into one workbook using a macro
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 "Dave Peterson" wrote in message ... Try uncommenting this line: 'msgbox "Nothing found in this folder: " & sf Maybe it'll give you an idea what's going wrong. Sam Commar wrote: 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 "Dave Peterson" wrote in message ... 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 Sam Commar wrote: 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 -- Dave Peterson -- Dave Peterson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Combine worksheets of multiple workbooks into one workbook using amacro
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 Commar wrote: 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 "Dave Peterson" wrote in message ... Try uncommenting this line: 'msgbox "Nothing found in this folder: " & sf Maybe it'll give you an idea what's going wrong. Sam Commar wrote: 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 "Dave Peterson" wrote in message ... 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 Sam Commar wrote: 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 -- Dave Peterson -- Dave Peterson -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Combine multiple workbooks into one workbook | Excel Discussion (Misc queries) | |||
Combine Workbooks with Same Prefix into One New Workbook | Excel Programming | |||
Compare two Workbooks and combine data into one workbook | Excel Programming | |||
Combine workbooks into one master workbook. | Excel Programming | |||
Combine multiple workbooks into one workbook | Excel Discussion (Misc queries) |