Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
I need some help creating a macro that will create new workbooks from a
defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
I have to leave. this code does most of your needs. I think it works, but
don't have time to fully test. Let me know the results. To run code highlight the cells A2:B6 then run macro Sub copyworkbook() Const MyPath = "c:\temp\" Set MyRange = ActiveCell Set OldWorkbook = ThisWorkbook firstRow = MyRange.Row Lastrow = MyRange.End(xlDown).Row For RowCount = firstRow To Lastrow OldWorkbook.Worksheets("sheet1").Activate Myworksheet = Cells(RowCount, 1) MyWorkbook = Cells(RowCount, 2) Set NewBook = Workbooks.Add On Error Resume Next NewBook.SaveAs Filename:=MyPath + MyWorkbook Workbooks(MyWorkbook).Sheets.Add ActiveSheet.Name = Myworksheet OldWorkbook.Worksheets(Myworksheet).Copy MyWorkbook.Worksheets(Myworksheet).Paste Workbooks(MyWorkbook).Close Next RowCount End Sub "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
the following untested pseudo code should get you started.
Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
Tom, this works fine for when there is a one worksheet to one new workbook, but falls over when it has to add more than one worksheet to the new workbook. I keep getting a runtime error '438' : Object doesn't support this method or object ... When I try and debug, it highlights the following piece of your code : bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk.workheets.Count) I have tried to fix it, but haven't been successful. Thanks -- Regards & Thanks "Tom Ogilvy" wrote: the following untested pseudo code should get you started. Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
Try
.... _ bk1.Worksheets(bk1.workheets.Count) (bk1 in both spots) Ian wrote: Tom, this works fine for when there is a one worksheet to one new workbook, but falls over when it has to add more than one worksheet to the new workbook. I keep getting a runtime error '438' : Object doesn't support this method or object ... When I try and debug, it highlights the following piece of your code : bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk.workheets.Count) I have tried to fix it, but haven't been successful. Thanks -- Regards & Thanks "Tom Ogilvy" wrote: the following untested pseudo code should get you started. Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks -- Dave Peterson |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
no...same error
-- Regards & Thanks "Dave Peterson" wrote: Try .... _ bk1.Worksheets(bk1.workheets.Count) (bk1 in both spots) Ian wrote: Tom, this works fine for when there is a one worksheet to one new workbook, but falls over when it has to add more than one worksheet to the new workbook. I keep getting a runtime error '438' : Object doesn't support this method or object ... When I try and debug, it highlights the following piece of your code : bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk.workheets.Count) I have tried to fix it, but haven't been successful. Thanks -- Regards & Thanks "Tom Ogilvy" wrote: the following untested pseudo code should get you started. Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks -- Dave Peterson |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
It looks like you changed Tom's code.
Maybe you made a different change that broke that line. I'd go back to Tom's original response and try it again. If that doesn't help, post the code you're using. Ian wrote: no...same error -- Regards & Thanks "Dave Peterson" wrote: Try .... _ bk1.Worksheets(bk1.workheets.Count) (bk1 in both spots) Ian wrote: Tom, this works fine for when there is a one worksheet to one new workbook, but falls over when it has to add more than one worksheet to the new workbook. I keep getting a runtime error '438' : Object doesn't support this method or object ... When I try and debug, it highlights the following piece of your code : bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk.workheets.Count) I have tried to fix it, but haven't been successful. Thanks -- Regards & Thanks "Tom Ogilvy" wrote: the following untested pseudo code should get you started. Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks -- Dave Peterson -- Dave Peterson |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
he code worked fine for me if the original code is used
bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk1.workheets.Count) the 1st bk is bk the 2nd bk is bk1 the 3rd bl is bk1 "Ian" wrote: no...same error -- Regards & Thanks "Dave Peterson" wrote: Try .... _ bk1.Worksheets(bk1.workheets.Count) (bk1 in both spots) Ian wrote: Tom, this works fine for when there is a one worksheet to one new workbook, but falls over when it has to add more than one worksheet to the new workbook. I keep getting a runtime error '438' : Object doesn't support this method or object ... When I try and debug, it highlights the following piece of your code : bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk.workheets.Count) I have tried to fix it, but haven't been successful. Thanks -- Regards & Thanks "Tom Ogilvy" wrote: the following untested pseudo code should get you started. Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks -- Dave Peterson |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to Copy Mulitple Worksheets to New Multiple Workbooks
many thanks..
went back and re-cut&paste Tom's original two lines and it now works ! -- Regards & Thanks "Dave Peterson" wrote: It looks like you changed Tom's code. Maybe you made a different change that broke that line. I'd go back to Tom's original response and try it again. If that doesn't help, post the code you're using. Ian wrote: no...same error -- Regards & Thanks "Dave Peterson" wrote: Try .... _ bk1.Worksheets(bk1.workheets.Count) (bk1 in both spots) Ian wrote: Tom, this works fine for when there is a one worksheet to one new workbook, but falls over when it has to add more than one worksheet to the new workbook. I keep getting a runtime error '438' : Object doesn't support this method or object ... When I try and debug, it highlights the following piece of your code : bk.Worksheets(cell.Value).Copy After:= _ bk1.Worksheets(bk.workheets.Count) I have tried to fix it, but haven't been successful. Thanks -- Regards & Thanks "Tom Ogilvy" wrote: the following untested pseudo code should get you started. Sub CreateWorkbooks() Dim rng as Range, bk as Workbook Dim cell as Range, bk1 as Workbook Dim sbkName as String, sPath as String ' location to save the new workbooks sPath = "C:\Myfolder\" set rng = Range("List_WSName") set bk = rng.parent.parent for each cell in rng sbkName = cell.offset(0,1).value & ".xls" set bk1 = Nothing on error resume next set bk1 = workbooks(sbkName) on error goto 0 if bk1 is nothing then bk.worksheets(cell.value).copy Activeworkbook.SaveAs sPath & sbkName else bk.worksheets(cell.value).copy After:= _ bk1.worksheets(bk1.worksheets.count) end if Next for each bk1 in Application.Workbooks if bk1.name < bk.name then bk1.Close Savechanges:=True end if Next end Sub -- Regards, Tom Ogilvy "Ian" wrote: I need some help creating a macro that will create new workbooks from a defined list of selected worksheets in master workbook. Example is explained below, based on the following table in cells A1:B6, with range called List_WSName in A2:A6 Wsheet Name New Workbook Name WSheet01 NewWB01 WSheet02 NewWB01 WSheet03 NewWB02 WSheet04 NewWB03 WSheet05 NewWB02 so based on the above data, the macro should create 3 new workbooks : (1) NewWB01 would contain copies of WSheet01 & WSheet02 (2) NewWB02 --------------"------------ WSheet03 & WSheet05 (3) NewWb03 --------------"------------ WSheet04 Any help greatly appreciated Thanks -- Dave Peterson -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Copy selected mulitple worksheets to mulitple new workbooks | Excel Programming | |||
Copy selected mulitple worksheets to mulitple new workbooks | Excel Programming | |||
Creating mulitple workbooks from single workbook - *Macro tweaking needed* | Excel Programming | |||
Automatically copy macro to multiple workbooks? | Excel Programming | |||
macro: copy multiple workbooks to multiple tabs in single book | Excel Programming |