Help needed: Getting all sheet setup data from one workbook toanother workbook

[Lostguy]

All,

"Joel" made up the below code, but I would like it to reside in
Personal.xls and run on another workbook that the user chooses
(through application.getopenfilename?). After it extracts the page
setup data from each sheet in the target workbook, it would add a
sheet to Personal.xls and then dump the data to that sheet.(Now you
have report showing the page setup of each page of your target
workbook.)

Right now, it adds the sheet to the target workbook, rather than to
personal.xls.

Any help appreciated! Thanks!
VR/
Lost





Public Sub PageSetupData()
Dim i As Long
Dim wks As Worksheet

'get correct workbook
For Each bk In Workbooks
If bk <> ThisWorkbook Then
Set newbk = bk
Exit For
End If
Next bk

With newbk
..Sheets.Add


On Error Resume Next


With .Range("A1")


..Offset(0, 0).Value = "WKS Name"
..Offset(0, 1).Value = "Print Title Rows"
..Offset(0, 2).Value = "Print Title Columns"
..Offset(0, 3).Value = "Print Area"
..Offset(0, 4).Value = "Left Header"
..Offset(0, 5).Value = "Center Header"
..Offset(0, 6).Value = "Right Header"
..Offset(0, 7).Value = "Left Footer"
..Offset(0, 8).Value = "Center Footer"
..Offset(0, 9).Value = "Right Footer"
..Offset(0, 10).Value = "Left Margin"
..Offset(0, 11).Value = "Right Margin"
..Offset(0, 12).Value = "Top Margin"
..Offset(0, 13).Value = "Bottom Margin"
..Offset(0, 14).Value = "Head Margin"
..Offset(0, 15).Value = "Foot Margin"
..Offset(0, 16).Value = "Print Headings"
..Offset(0, 17).Value = "Print Gridlines"
..Offset(0, 18).Value = "Print Comments"
..Offset(0, 19).Value = "Print Quality"
..Offset(0, 20).Value = "Center Horizontally"
..Offset(0, 21).Value = "Center Vertically"
..Offset(0, 22).Value = "Orientation"
..Offset(0, 23).Value = "Draft"
..Offset(0, 24).Value = "Paper Size"
..Offset(0, 25).Value = "First Page Number"
..Offset(0, 26).Value = "Order"
..Offset(0, 27).Value = "Black and White"
..Offset(0, 28).Value = "Zoom"
..Offset(0, 29).Value = "Print Errors"

End With

..Range("A1").Select
For Each wks In .Worksheets
i = i + 1
ActiveCell.Offset(i, 0).Value = wks.Name

With wks.PageSetup
ActiveCell.Offset(i, 1).Value = .PrintTitleRows
ActiveCell.Offset(i, 2).Value = .PrintTitleColumns
ActiveCell.Offset(i, 3).Value = .PrintArea
ActiveCell.Offset(i, 4).Value = .LeftHeader
ActiveCell.Offset(i, 5).Value = .CenterHeader
ActiveCell.Offset(i, 6).Value = .RightHeader
ActiveCell.Offset(i, 7).Value = .LeftFooter
ActiveCell.Offset(i, 8).Value = .CenterFooter
ActiveCell.Offset(i, 9).Value = .RightFooter
ActiveCell.Offset(i, 10).Value = .LeftMargin
ActiveCell.Offset(i, 11).Value = .RightMargin
ActiveCell.Offset(i, 12).Value = .TopMargin
ActiveCell.Offset(i, 13).Value = .BottomMargin
ActiveCell.Offset(i, 14).Value = .HeaderMargin
ActiveCell.Offset(i, 15).Value = .FooterMargin
ActiveCell.Offset(i, 16).Value = .PrintHeadings
ActiveCell.Offset(i, 17).Value = .PrintGridlines
ActiveCell.Offset(i, 18).Value = .PrintComments
ActiveCell.Offset(i, 19).Value = .PrintQuality
ActiveCell.Offset(i, 20).Value = .CenterHorizontally
ActiveCell.Offset(i, 21).Value = .CenterVertically
ActiveCell.Offset(i, 22).Value = .Orientation
ActiveCell.Offset(i, 23).Value = .Draft
ActiveCell.Offset(i, 24).Value = .PaperSize
ActiveCell.Offset(i, 25).Value = .FirstPageNumber
ActiveCell.Offset(i, 26).Value = .Order
ActiveCell.Offset(i, 27).Value = .BlackAndWhite
ActiveCell.Offset(i, 28).Value = .Zoom
ActiveCell.Offset(i, 29).Value = .PrintErrors
End With


Next wks


'format worksheet
Range("B2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Columns("A:AD").Select
Columns("A:AD").EntireColumn.AutoFit
Range("B2").Select

End With
exit_Sub:
On Error Resume Next
Exit Sub


err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: PageSetupData - Module: " & _
"Mod_PageSetup_Wkst - " & Now()
GoTo exit_Sub


End Sub

 

[Lost]

All,

Responding to my own post. With Joel's massive guidance this morning, the
code now works like I want. (I probably sloppied-up his code, but I lack his
expertise.)

Run it from your Personal.xls, select a workbook to test, and the report
sheet for what's being tested gets added to Personal.xls. Poof...the setup
data for each sheet in the workbook rather than having to go to each sheet
individually. Thanks Joel and NG!!!!:

Public Sub PageSetupData()
Dim i As Long
Dim wks As Worksheet
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls),
*.xls", Title:="Please select a file")
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
On Error GoTo Erro
Workbooks.Open Filename:=NewFN
End If
Set oldbk = Workbooks.Open(Filename:=NewFN)

With ThisWorkbook
Set newsht = .Sheets.Add(after:=.Sheets(.Sheets.Count))
End With

Set Dest = newsht.Range("A1")

On Error Resume Next


With Dest

.Offset(0, 0).Value = "WKS Name"
.Offset(0, 1).Value = "Print Title Rows"
.Offset(0, 2).Value = "Print Title Columns"
.Offset(0, 3).Value = "Print Area"
.Offset(0, 4).Value = "Left Header"
.Offset(0, 5).Value = "Center Header"
.Offset(0, 6).Value = "Right Header"
.Offset(0, 7).Value = "Left Footer"
.Offset(0, 8).Value = "Center Footer"
.Offset(0, 9).Value = "Right Footer"
.Offset(0, 10).Value = "Left Margin"
.Offset(0, 11).Value = "Right Margin"
.Offset(0, 12).Value = "Top Margin"
.Offset(0, 13).Value = "Bottom Margin"
.Offset(0, 14).Value = "Head Margin"
.Offset(0, 15).Value = "Foot Margin"
.Offset(0, 16).Value = "Print Headings"
.Offset(0, 17).Value = "Print Gridlines"
.Offset(0, 18).Value = "Print Comments"
.Offset(0, 19).Value = "Print Quality"
.Offset(0, 20).Value = "Center Horizontally"
.Offset(0, 21).Value = "Center Vertically"
.Offset(0, 22).Value = "Orientation"
.Offset(0, 23).Value = "Draft"
.Offset(0, 24).Value = "Paper Size"
.Offset(0, 25).Value = "First Page Number"
.Offset(0, 26).Value = "Order"
.Offset(0, 27).Value = "Black and White"
.Offset(0, 28).Value = "Zoom"
.Offset(0, 29).Value = "Print Errors"

End With

i = 1
For Each wks In oldbk.Worksheets
Dest.Offset(i, 0).Value = wks.Name

With wks.PageSetup
Dest.Offset(i, 1).Value = .PrintTitleRows
Dest.Offset(i, 2).Value = .PrintTitleColumns
Dest.Offset(i, 3).Value = .PrintArea
Dest.Offset(i, 4).Value = .LeftHeader
Dest.Offset(i, 5).Value = .CenterHeader
Dest.Offset(i, 6).Value = .RightHeader
Dest.Offset(i, 7).Value = .LeftFooter
Dest.Offset(i, 8).Value = .CenterFooter
Dest.Offset(i, 9).Value = .RightFooter
Dest.Offset(i, 10).Value = .LeftMargin
Dest.Offset(i, 11).Value = .RightMargin
Dest.Offset(i, 12).Value = .TopMargin
Dest.Offset(i, 13).Value = .BottomMargin
Dest.Offset(i, 14).Value = .HeaderMargin
Dest.Offset(i, 15).Value = .FooterMargin
Dest.Offset(i, 16).Value = .PrintHeadings
Dest.Offset(i, 17).Value = .PrintGridlines
Dest.Offset(i, 18).Value = .PrintComments
Dest.Offset(i, 19).Value = .PrintQuality
Dest.Offset(i, 20).Value = .CenterHorizontally
Dest.Offset(i, 21).Value = .CenterVertically
Dest.Offset(i, 22).Value = .Orientation
Dest.Offset(i, 23).Value = .Draft
Dest.Offset(i, 24).Value = .PaperSize
Dest.Offset(i, 25).Value = .FirstPageNumber
Dest.Offset(i, 26).Value = .Order
Dest.Offset(i, 27).Value = .BlackAndWhite
Dest.Offset(i, 28).Value = .Zoom
Dest.Offset(i, 29).Value = .PrintErrors
End With


i = i + 1
Next wks


'format worksheet
newsht.Range("B2").FreezePanes = True
newsht.Columns("A:AD").EntireColumn.AutoFit
newsht.Range("B2").Select

exit_Sub:
On Error Resume Next
oldbk.Close savechanges:=False
Exit Sub


err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: PageSetupData - Module: " & _
"Mod_PageSetup_Wkst - " & Now()
GoTo exit_Sub

Erro:

Select Case Err
Case 0
MsgBox "Macro completed successfully (or was cancelled by user)."
Case Else
MsgBox "There is something wrong: " & Chr(10) & _
Err & ": " & Err.Description
End Select

Err.Clear
End Sub