vba resize all sheets at once

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
363
Office Version
  1. 2019
Hello All,
i use this code in my workbook but then i added sheet10 as data collection, so i dont want to run it on sheet10 recently, what should i do to run exclude sheet10?
ps. sheet10 named data
thank you very much and credit to gordsky here

VBA Code:
Sub Macro1()
'
' Macro1 Macro
'

'

Dim ws As Worksheet
Dim wb As Workbook

Set wb = ThisWorkbook

For Each ws In ThisWorkbook.Worksheets

    With ws
      .Rows(1).RowHeight = 100
      .Rows("2:5").RowHeight = 20
      .Rows("10:39").RowHeight = 40
      .Range("B1:F1,B5:F5").Merge
      .Columns("B").EntireColumn.AutoFit
      .Columns(1).ColumnWidth = 12
      .Columns("G:H").ColumnWidth = 15
      .Columns("D").ColumnWidth = 80
    End With

    With ws.Range("B1").Font
      .Name = "Calibri"
      .Size = 75
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("B2:B5").Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

    With ws.Range("D10:D39")
    With .Font
      .Name = "Calibri"
      .Size = 14
      .Strikethrough = False
      .Superscript = False
      .Subscript = False
      .OutlineFont = False
      .Shadow = False
      .Underline = xlUnderlineStyleNone
      .Color = -16777216
      .TintAndShade = 0
      .ThemeFont = xlThemeFontNone
    End With

        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With

    With ws.Range("B1:F1,B2:F2,B3:F3,B4:F4,B5:F5")
     .Merge
     .HorizontalAlignment = xlLeft
     .VerticalAlignment = xlTop
     .WrapText = False
     .Orientation = 0
     .AddIndent = False
     .IndentLevel = 0
     .ShrinkToFit = False
     .ReadingOrder = xlContext
    End With

    ws.Activate
    ws.Range("A1").Select
 
Next ws
    
    Sheets(1).Select
    With Sheets(1)
    .Columns.UseStandardWidth = True
    .Rows.UseStandardHeight = True
    .Rows.RowHeight = 15
    .Columns.ColumnWidth = 9
    ActiveSheet.Cells.UnMerge
    
End With
End Sub
 

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
363
Office Version
  1. 2019
Hi mumps and johnnyL

what do i need to amend if i have 2 more sheets as exclusion?
sheet 10, sheet 7 and sheet 3

thank you very much
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,825
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Change:
VBA Code:
        If ws.CodeName <> "Sheet10" Then        ' <--- set the Code name of the sheet that you don't want the code to run on

to:
VBA Code:
        If ws.CodeName <> "Sheet10" and ws.CodeName <> "Sheet7" and ws.CodeName <> "Sheet3" Then        ' <--- set the Code name of the sheets that you don't want the code to run on
 

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
363
Office Version
  1. 2019
Change:
VBA Code:
        If ws.CodeName <> "Sheet10" Then        ' <--- set the Code name of the sheet that you don't want the code to run on

to:
VBA Code:
        If ws.CodeName <> "Sheet10" and ws.CodeName <> "Sheet7" and ws.CodeName <> "Sheet3" Then        ' <--- set the Code name of the sheets that you don't want the code to run on
Hi johnnyL
thank you very much for your reply

i did tried but i curious why it stopped and say
"the selection contains multiple data values. merging into one cell will keep the upper-left most data only"
yellow highlighted:
VBA Code:
.Range("B1:F1,B5:F5").Merge
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,825
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
I avoid using merge so I can't help with that.

You could do the merge with other code.
 

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
363
Office Version
  1. 2019
I avoid using merge so I can't help with that.

You could do the merge with other code.
Hi johnnyL
thank you very much for your reply

i really dont understand why it cant run when i add another exclusion
Code:
If ws.CodeName <> "Sheet10" and ws.CodeName <> "Sheet2" Then
can i put the merge code to last one or use another macro to run it?
how do i separate?

thank you very much

VBA Code:
Sub Macro1()
'
' Macro1 Macro
'
    Dim ws As Worksheet
    Dim wb As Workbook
'
    Set wb = ThisWorkbook
'
    For Each ws In ThisWorkbook.Worksheets
        If ws.CodeName <> "Sheet10" Then        ' <--- set the Code name of the sheet that you don't want the code to run on
            With ws
                .Rows(1).RowHeight = 100
                .Rows("2:5").RowHeight = 20
                .Rows("10:39").RowHeight = 40
                .Range("B1:F1,B5:F5").Merge
                .Columns("B").EntireColumn.AutoFit
                .Columns(1).ColumnWidth = 12
                .Columns("G:H").ColumnWidth = 15
                .Columns("D").ColumnWidth = 80
            End With
'
            ws.Range("B1").Font.Size = 75
            ws.Range("B2:B5", "D10:D39").Font.Size = 14
'
            With ws.Range("B1:B5", "D10:D39").Font
                .Name = "Calibri"
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .Color = -16777216
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
'
            With ws.Range("D10:D39")
                .HorizontalAlignment = xlGeneral
                .WrapText = True
            End With
'
            With ws.Range("B1:F5")
                .Merge
                .HorizontalAlignment = xlLeft
                .WrapText = False
            End With
'
            With ws.Range("B1:F5", "D10:D39")
                .VerticalAlignment = xlTop
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
            End With
'
            ws.Activate
            ws.Range("A1").Select
        End If
    Next ws
'
    Sheets(1).Select
    With Sheets(1)
        .Columns.UseStandardWidth = True
        .Rows.UseStandardHeight = True
        .Rows.RowHeight = 15
        .Columns.ColumnWidth = 9
        ActiveSheet.Cells.UnMerge
    End With
End Sub
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
3,825
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
You could add:
VBA Code:
    Dim Cel As Range

and then replace:
VBA Code:
.Range("B1:F1,B5:F5").Merge

with:
VBA Code:
    For Each Cel In .Range("C1:F1")
        .Range("B1") = .Range("B1") & " " & Cel.Value
    Next
    .Range("C1:F1").ClearContents
'
    For Each Cel In .Range("C5:F5")
        .Range("B5") = .Range("B5") & " " & Cel.Value
    Next
    .Range("C5:F5").ClearContents
 

kelvin_9

Active Member
Joined
Mar 6, 2015
Messages
363
Office Version
  1. 2019
You could add:
VBA Code:
    Dim Cel As Range

and then replace:
VBA Code:
.Range("B1:F1,B5:F5").Merge

with:
VBA Code:
    For Each Cel In .Range("C1:F1")
        .Range("B1") = .Range("B1") & " " & Cel.Value
    Next
    .Range("C1:F1").ClearContents
'
    For Each Cel In .Range("C5:F5")
        .Range("B5") = .Range("B5") & " " & Cel.Value
    Next
    .Range("C5:F5").ClearContents
Hi johnnyL
thank you very much for your reply

despite i dont understand why i have 2 sheets in my workbook but only 1 in VBA window, i think this is the main reason why i can't run the code even with
VBA Code:
If ws.CodeName <> "Sheet1" And ws.CodeName <> "Sheet2" Then
1.jpg

anyway, i run this in other computer like at my office, it works prefect and no error

thank you very much as always
wish you all the best
 

Forum statistics

Threads
1,176,668
Messages
5,904,366
Members
435,087
Latest member
maiarib

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top