Applying range modifications in multiple sheets

2019-08-13 04:22发布

I have a workbook with 12 sheets (which have the abbreviated name of each month) plus two extra support sheets. I want to create a macro where I could define a number of different ranges (in teh example below, there are 5 ranges), group them in an array and merge those ranges, one by one, on all the monthly worksheets. I came across with the following code (which runs without errors and apparently runs through all the worksheets I demanded) - but only applies the transformations on the first worksheet ("Jan") and does nothing on the others? Could you please help me find where's my mistake? Thanks in advance to you all!

Sub layout()

Dim rng1, rng2, rng3, rng4, rng5 As Range

Set rng1 = Range("A2:C3")
Set rng2 = Range("A4:A5")
Set rng3 = Range("B4:B5")
Set rng4 = Range("C4:C5")
Set rng5 = Range("D2:D5")

Dim arr As Variant
arr = Array(rng1, rng2, rng3, rng4, rng5)

Dim wb As Workbook
Set wb = Application.Workbooks("Book1")

Dim ws As Worksheet
Dim i As Integer

For Each ws In wb.Sheets
    Select Case ws.name
    Case Is = "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
        For i = 0 To 4
        ws.Activate
        arr(i).Merge
        Next
    End Select
Next ws

End Sub

2条回答
ゆ 、 Hurt°
2楼-- · 2019-08-13 05:04

Your Case statement is mildly malformed and activating the worksheet to inherit the active worksheet as the default parent worksheet should be outside the loop.

However the primary problem is that you are setting the range objects. Changing the active sheet is not going to rewrite the parent worksheet of these range objects. The set parent worksheet will remain despite changing the active worksheet.

The solution is to array the address strings and construct the ranges on the fly.

Option Explicit

Sub layout()
    Dim arr As Variant, wb As Workbook, ws As Worksheet, i As Integer
    arr = Array("A2:C3", "A4:A5", "B4:B5", "C4:C5", "D2:D5")

    Set wb = Application.Workbooks("Book1")

    For Each ws In wb.Worksheets
        Select Case ws.Name
            Case "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"
                For i = 0 To 4
                    ws.Range(arr(i)).Merge
                Next
        End Select
    Next ws

End Sub
查看更多
一夜七次
3楼-- · 2019-08-13 05:10

I don't know the name of those 2 extra support sheets, let's call them just SupoortSheet1 and Supportsheet 2. Use a Select case to do nothing in those 2 cases, and any other case, you merge:

For Each ws In wb.Sheets
    Select Case ws.Name
        Case "SupportSheet1"
            'do nothing
        Case "SupportSheet2"
            'do nothing
        Case Else
            'it's a month sheet. We merge
            For i = 0 To 4
                ws.Activate
                arr(i).Merge
            Next
    End Select
Next ws

Just more info about Case Else (really useful sometimes), read here

查看更多
登录 后发表回答