I have an excel program that is set to create a workbook, import data into 2 worksheets and reformat the sheets for printing. I need to format the print settings for both worksheets but the print settings on the second worksheet are not being saved. The program works fine when I go step by step but when I close the workbook and open it back up, the second worksheet has lost its print settings. I am including the entire program but step 17 is what is being lost. I am sure it must be something simple but am at a loss. If I set the workbook to save but not close (stop after ActiveWorkbook. Save) and then close the workbook manually it does save the settings, but I need this to run automatically.
Code:
Option Explicit
Sub Reformat()
'
' List Macro
'
'3-4 Prompt for date and open today's file
Dim DateToday As String
Dim NewBook As Workbook
DateToday = Format((Now), "mm-dd-yy")
'1. Create the workbook
Set NewBook = Workbooks.Add(1)
NewBook.SaveAs Filename:="C:\workbook_" & DateToday & ".xls", FileFormat:=56
Workbooks.Open Filename:="C:\workbook_" & DateToday & ".xls"
'2. Import the Sheet 1 data
ActiveWorkbook.ActiveSheet.Name = "sheet1" & DateToday
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;link" _
, Destination:=Range("$A$1"))
.Name = "sheet1" & Now()
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'3. Delete data connections
ActiveSheet.QueryTables(1).Delete
'4. Add Cultures column and sort by Last in Lab (Descending)
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells.Sort Key1:=Range("X1"), Order1:=xlDescending, Header:=xlYes
Range("A1").Select
ActiveCell.FormulaR1C1 = "Cultures"
'5. Format first row and rename fields
Rows("1:1").Font.Bold = True
Rows("1:1").HorizontalAlignment = xlCenter
Rows("1:1").VerticalAlignment = xlBottom
'6. Format date columns
Range("F:F,K:K,W:W,X:X").Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
'7. Autofit columns
Cells.EntireColumn.AutoFit
'8. Hide unnecessary columns
Range("E:E,J:J,M:M,O:V").EntireColumn.Hidden = True
'9. Format for printing
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.PrintGridlines = True
.CenterHorizontally = True
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterFooter = "&""Century Schoolbook,Regular""&20&A"
End With
Range("A1").Select
'10. Import the Sheet 2 data
ActiveWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "sheet2" & DateToday
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;link2" _
, Destination:=Range("$A$1"))
.Name = "sheet2" & Now()
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'11. Delete data connections
ActiveSheet.QueryTables(1).Delete
'12. Add Cultures column and sort by Last in Lab (Descending)
Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells.Sort Key1:=Range("X1"), Order1:=xlDescending, Header:=xlYes
Range("A1").Select
ActiveCell.FormulaR1C1 = "Cultures"
'13. Format first row and rename fields
Rows("1:1").Font.Bold = True
Rows("1:1").HorizontalAlignment = xlCenter
Rows("1:1").VerticalAlignment = xlBottom
'14. Format date columns
Range("F:F,K:K,W:W,X:X").Select
Selection.NumberFormat = "[$-409]m/d/yy h:mm AM/PM;@"
'15. Autofit columns
Cells.EntireColumn.AutoFit
'16. Hide unnecessary columns
Range("E:E,J:J,M:M,O:V").EntireColumn.Hidden = True
'17. Format for printing
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.PrintGridlines = True
.CenterHorizontally = True
.Orientation = xlLandscape
.FitToPagesWide = 1
.FitToPagesTall = 1
.CenterFooter = "&""Century Schoolbook,Regular""&20&A"
End With
Range("A1").Select
'18. Go back to first worksheet, close and save
Sheets(1).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close True
End Sub
Comment