在多张纸上套用格式

Question

I have searched and tried multiple different codes and way out there, but have had no luck finding a solution. I am trying to take a macro setup to format one sheet, which works perfectly, and apply the same code to all sheets in the workbook. I have searched multiple codes and sheet array formulas but are unable to either apply them to the code I have or understand them enough to change what needs to be changed in order for them to work. I am fairly new to the macro world and do not understand the programming language at all. I appreciate anyone's time that they put into helping me on this as I have been struggling with this for several weeks now. Thank you. The following code is what i have thus far:

Sub DARprintready()
'
' DARprintready Macro
'

'
    Columns("A:A").Select
    Selection.columnwidth = 2.86
    Columns("B:B").Select
    Selection.columnwidth = 4.57
    Columns("C:C").Select
    Selection.columnwidth = 13.57
    Columns("D:D").Select
    Selection.columnwidth = 8.57
    Columns("E:E").Select
    Selection.columnwidth = 20.86
    Columns("F:F").Select
    Selection.columnwidth = 8.43
    Columns("G:H").Select
    Selection.columnwidth = 9.43
    Columns("I:I").Select
    Selection.columnwidth = 9.14
    Columns("J:J").Select
    Selection.columnwidth = 9.43
    Columns("K:K").Select
    Selection.columnwidth = 50.4
    Columns("L:L").Select
    Selection.columnwidth = 9
    Range("E:E,K:K").Select
    Range("K1").Activate
    Selection.NumberFormat = "@"
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-15
    Columns("A:L").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-6
    Columns("A:A").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A1").Select
    Sheets("Header").Select
    Range("A1:L4").Select
    Selection.Copy
    Sheets("Firmwide").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.18)
        .RightMargin = Application.InchesToPoints(0.16)
        .TopMargin = Application.InchesToPoints(0.17)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.17)
        .FooterMargin = Application.InchesToPoints(0.16)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 80
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub

Answer 1

To add a bit to the other answer, use a with statement as a shorthand for all of your changes, so you don't have to keep typing the sheet name over and over

Sub ColWidth()
    Dim wkst As Worksheet
    For Each wkst In ThisWorkbook.Sheets
        With wkst
            .Columns("A:A").ColumnWidth = 2.86
            .Columns("B:B").ColumnWidth = 4.57
            .Columns("C:C").ColumnWidth = 13.57
            .Columns("D:D").ColumnWidth = 8.57
        End With
    Next

End Sub

(you'll have to adopt the rest of it to this form)

Also, consider keeping your column widths in an array, and assigning them to the columns in a loop. It won't speed things up, but your code will be more compact, and, I think, readable.

Eg,

Dim i As Integer
Dim widths() As Variant
widths = Array(4.5, 3.67, 5, 6.45, 10)

For i = 1 To 5
    Columns(i).ColumnWidth = widths(i) `Thank you iDevlop for the less Rube Goldberg approach
Next

That way, you can add more columns in at will without having to type everything out.

Answer 2

Step 1 will be learning some VBA. Fortunately the task you are attempting doesn't require you to learn a tonne.

Assuming that you need EXACTLY the same formatting on ALL sheets, you need to loop through the sheets.

In order to do this you'll need to do 3 things.

1. Create a variable for the target sheet name
2. Put your formatting inside a Loop that goes through each sheet
3. Replace the hardcoded sheet names in your macro with your variable name

Your code will end up something like this

Sub DARprintready() ' ' DARprintready Macro '
dim Outputsheet as workhsheet

for each Outputsheet in activeworkbook.sheets

  outputsheet.select
  'your formatting code here


next

You'll need to change that explicit reference to the sheet firmwide with a reference to the variable you just created.

replace this:

Sheets("Firmwide").Select

with this:

Outputsheet.Select

hope that helps,

Answer 3

As usual, I'm a little late, but here's a better solution. Feel free to mark mine as right if you feel it is a better solution. This way formats all the sheets at once avoiding the loop and is much faster since it is internal to Excel where the loops happen.

    Dim shs As Sheets, wks As Worksheet
    Dim rFormat As Range

    Set wks = ActiveWorkbook.Worksheets("Sheet1")
    Set shs = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2"))

    shs.Select

    Set rFormat = wks.Range("A1:A2,C3:C4")
    rFormat.Select
    With Selection
        .Font.ColorIndex = 3
        .Interior.ColorIndex = 6
        .Interior.Pattern = xlSolid
    End With

    wks.Select

Answer 4

The above code did not work in my case, because it was missing to activate one of the 3 (or more) worksheets to get formatted. Since I spent some time for solving this issue, I'm sharing that piece of code. Obviusliy this can be improved, for example using arrays also for the format patterns.

Sub PivotTabsFormatting()
'
' PivotTabsFormatting Macro
' This formats a column range columns on multiple sheets
' Keyboard Shortcut: Ctrl+a
' By PhB- Dec'18
'
Dim shs As Sheets
Dim wks As Worksheet
Dim rFormat1 As Range
Dim rFormat2 As Range

    Set wks = ActiveWorkbook.Worksheets("Sheet1")
    Set shs = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
    Set rFormat1 = wks.Columns("D:O") 'could also be :  .Range("D4:M10")
    Set rFormat2 = wks.Columns("B:C") 'could also be :  .Range("B6:C6")

    shs.Select
    wks.Activate ' --> this was missing

    With rFormat1
        .ColumnWidth = 15
    End With

    With rFormat2
        .EntireColumn.AutoFit
    End With

    wks.Select
    wks.Range("A1").Select

End Sub

Answer 5

For a quick method:

   Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
   Columns("A:E").EntireColumn.AutoFit