Help needed: Getting all sheet setup data from one workbook to ano
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
|