vba resize all sheets at once

[kelvin_9]

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

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]

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

 

[johnnyL]

Change:

        If ws.CodeName <> "Sheet10" Then        ' <--- set the Code name of the sheet that you don't want the code to run on

to:

        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]

Change:

        If ws.CodeName <> "Sheet10" Then        ' <--- set the Code name of the sheet that you don't want the code to run on

to:

        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:

.Range("B1:F1,B5:F5").Merge

 

[johnnyL]

I avoid using merge so I can't help with that.

You could do the merge with other code.

 

[kelvin_9]

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

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

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]

You could add:

    Dim Cel As Range

and then replace:

.Range("B1:F1,B5:F5").Merge

with:

    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]

You could add:

    Dim Cel As Range

and then replace:

.Range("B1:F1,B5:F5").Merge

with:

    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

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