Copy Page Setup Options when splitting into multiple workbooks

BankerZ

New Member
Joined
Jul 7, 2008
Messages
2
I have found success splitting one large worksheet into multiple workbooks based on common values in Column A of my spreadsheet with the macro below (thanks to Andrew Poulsom's solution in this thread: http://www.mrexcel.com/forum/showthread.php?t=319499.

I have two additional needs:

1 - To copy the Page Setup Options from the original worksheet to the new workbooks created.

2 - Password protect each of the new workbooks created.

What additions do I need to make to the following to make that possible.

Any assistance is greatly appreciated.

Sub Test()
Const xlColumnWidths = 8
Dim Sh As Worksheet
Dim Rng As Range
Dim c As Range
Dim List As New Collection
Dim Item As Variant
Dim WB As Workbook
Application.ScreenUpdating = False
'' *** Change Sheet name to suit ***
Set Sh = Worksheets("All")
Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
On Error Resume Next
For Each c In Rng
List.Add c.Value, CStr(c.Value)
Next c
On Error GoTo 0
Set Rng = Sh.Range("A1:AA" & Sh.Range("A65536").End(xlUp).Row)
For Each Item In List
Set WB = Workbooks.Add
Sh.Cells.Copy
WB.Worksheets(1).Range("A1").PasteSpecial Paste:=xlColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rng.AutoFilter Field:=1, Criteria1:=Item
Rng.SpecialCells(xlCellTypeVisible).Copy WB.Worksheets(1).Range("A1")
Rng.AutoFilter
With WB
.SaveAs ThisWorkbook.Path & "\ProjectName - " & Item & ".xls"
.Close
End With
Next Item
Sh.Activate
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
An additional option that will work for me is creating a unique worksheet within the original workbook (rather than creating a new workbook for each). Then I can simply highlight all worksheets and create the page options needed.

Any help with that thought would also be appreciated.
 
Upvote 0

Forum statistics

Threads
1,214,590
Messages
6,120,421
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top