ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   How to run a macro on all sheets? (https://www.excelbanter.com/excel-programming/359159-how-run-macro-all-sheets.html)

Todd

How to run a macro on all sheets?
 
Hi, I recorded the macro below. I deleted all the window scrolls and it
works but is very slow. Thats ok I guess but I want to run it on severals
sheets in a book. Whats the script I add to do that?


Sub PrintSettings()
'

' Keyboard Shortcut: Ctrl+Shift+A
'
ActiveWindow.View = xlPageBreakPreview
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = "$A:$E"
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$108"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F&A"
.CenterFooter = "&D"
.RightFooter = "&P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(0.28)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.17)
.FooterMargin = Application.InchesToPoints(0.17)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = 58
.PrintErrors = xlPrintErrorsDisplayed
End With
Columns("I:I").Select
ActiveWindow.SelectedSheets.VPageBreaks.Add Befo=ActiveCell
Columns("N:N").Select
ActiveWindow.SelectedSheets.VPageBreaks.Add Befo=ActiveCell

ActiveSheet.PageSetup.PrintArea = "$A$1:$T$108"
ActiveSheet.HPageBreaks(1).DragOff Direction:=xlUp, RegionIndex:=1

ActiveSheet.PageSetup.PrintArea = "$A$1:$T$110"
Columns("T:T").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit

ActiveWindow.View = xlNormalView

Range("A1").Select
End Sub

sebastienm

How to run a macro on all sheets?
 
Hi,
Try something like:
'----------------------------------------------------------
'Set sheets for active workbook
Sub Test()
dim wsh as worksheet
application.screenupdating=false
for each wsh in activeworkbook.worksheets
SetWorksheet wsh
next
End sub

'------------------------
' i changed a bit the code below; make sure it works as expected
Sub SetWorksheet(WSH As Worksheet)
If WSH Is Nothing Then Exit Sub

With WSH
With .PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = "$A:$E"
.PrintArea = "$A$1:$T$110" '"$A$1:$Q$108"
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F&A"
.CenterFooter = "&D"
.RightFooter = "&P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(0.28)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.17)
.FooterMargin = Application.InchesToPoints(0.17)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = 58
.PrintErrors = xlPrintErrorsDisplayed
End With

.VPageBreaks.Add Befo=.Columns("I:I")
.VPageBreaks.Add Befo=.Columns("N:N")
If .HPageBreaks.Count 0 Then
.HPageBreaks(1).DragOff Direction:=xlUp, RegionIndex:=1
End If
.Columns("T:T").EntireColumn.AutoFit
.Columns("M:M").EntireColumn.AutoFit

End With
End Sub
'---------------------------------------------------------
--
Regards,
Sébastien
<http://www.ondemandanalysis.com


"Todd" wrote:

Hi, I recorded the macro below. I deleted all the window scrolls and it
works but is very slow. Thats ok I guess but I want to run it on severals
sheets in a book. Whats the script I add to do that?


Sub PrintSettings()
'

' Keyboard Shortcut: Ctrl+Shift+A
'
ActiveWindow.View = xlPageBreakPreview
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = "$A:$E"
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$108"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&F&A"
.CenterFooter = "&D"
.RightFooter = "&P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(0.28)
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.17)
.FooterMargin = Application.InchesToPoints(0.17)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = 58
.PrintErrors = xlPrintErrorsDisplayed
End With
Columns("I:I").Select
ActiveWindow.SelectedSheets.VPageBreaks.Add Befo=ActiveCell
Columns("N:N").Select
ActiveWindow.SelectedSheets.VPageBreaks.Add Befo=ActiveCell

ActiveSheet.PageSetup.PrintArea = "$A$1:$T$108"
ActiveSheet.HPageBreaks(1).DragOff Direction:=xlUp, RegionIndex:=1

ActiveSheet.PageSetup.PrintArea = "$A$1:$T$110"
Columns("T:T").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit

ActiveWindow.View = xlNormalView

Range("A1").Select
End Sub



All times are GMT +1. The time now is 03:04 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com