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

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

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

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

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

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

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

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

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