How can I run this VBA code across each sheet in my workbook?

user_14740434 0
Viewed 45

I have a workbook of 60 sheets, each with identical formatting. I need to merge a bunch of cells in each one, so I have this code to do that. Is there a way I can run it across the entire document rather than have to run it individually on each sheet?

Sub MrgeColumns()
    Range("T3:T209").Merge
    Range("AU3:AU209").Merge
    Range("BT3:BT209").Merge
    Range("CS3:CS209").Merge
    Range("DS3:DS209").Merge
    Range("ET3:ET209").Merge
    Range("FT3:FT209").Merge
    Range("GR3:GR209").Merge
    Range("HP3:HP209").Merge
    Range("IN3:IN209").Merge
End Sub
vba excel
2 Answers

Give it a worksheet argument, and then you can call it using a loop.

Sub MergeAll()
  Dim ws as Worksheet
  For each ws in ActiveWorkbook.WorkSheets
    MrgeColumns ws
  Next
End Sub


Sub MrgeColumns(ws as Worksheet)
  With ws
    .Range("T3:T209").Merge
    .Range("AU3:AU209").Merge
    .Range("BT3:BT209").Merge
    .Range("CS3:CS209").Merge
    .Range("DS3:DS209").Merge
    .Range("ET3:ET209").Merge
    .Range("FT3:FT209").Merge
    .Range("GR3:GR209").Merge
    .Range("HP3:HP209").Merge
    .Range("IN3:IN209").Merge
  End With
End Sub
user_84229530

Merge Column Ranges Accross Worksheets

Option Explicit

' Merges the column ranges in all worksheets.
Sub TESTmergeColumnRanges()
    Const ColumnList As String = "T,AU,BT,CS,DS,ET,FT,GR,HP,IN"
    Const FirstRow As Long = 3
    Const LastRow As Long = 209
    mergeColumns ThisWorkbook, ColumnList, FirstRow, LastRow
End Sub

' Merges the column ranges in worksheets whose names are not
' in the Exceptions List.
Sub TESTmergeColumnRangesWithExceptions()
    Const ExceptionList As String = "Sheet2,Sheet4"
    Const ColumnList As String = "T,AU,BT,CS,DS,ET,FT,GR,HP,IN"
    Const FirstRow As Long = 3
    Const LastRow As Long = 209
    mergeColumns ThisWorkbook, ColumnList, FirstRow, LastRow, ExceptionList
End Sub

' Unmerges the column ranges in all worksheets.
Sub TESTunMergeColumnRanges()
    Const ColumnList As String = "T,AU,BT,CS,DS,ET,FT,GR,HP,IN"
    Const FirstRow As Long = 3
    Const LastRow As Long = 209
    mergeColumns ThisWorkbook, ColumnList, FirstRow, LastRow, , False
End Sub

Sub mergeColumns( _
        wb As Workbook, _
        ByVal ColumnList As String, _
        ByVal FirstRow As Long, _
        ByVal LastRow As Long, _
        Optional ByVal ExceptionList As String, _
        Optional ByVal doMerge As Boolean = True)
    Dim Cols() As String: Cols = Split(ColumnList, ",")
    Dim ws As Worksheet
    Dim n As Long
    If ExceptionList = "" Then
        For Each ws In wb.Worksheets
            mergeColumnsInWorksheet ws, Cols, FirstRow, LastRow, doMerge
        Next ws
    Else
        Dim Exceptions() As String: Exceptions = Split(ExceptionList, ",")
        For Each ws In wb.Worksheets
            If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
                mergeColumnsInWorksheet ws, Cols, FirstRow, LastRow, doMerge
            End If
        Next ws
    End If
End Sub

Sub mergeColumnsInWorksheet( _
        ws As Worksheet, _
        Cols() As String, _
        ByVal FirstRow As Long, _
        ByVal LastRow As Long, _
        Optional ByVal doMerge As Boolean = True)
    Dim n As Long
    With ws.Rows(FirstRow & ":" & LastRow)
        If doMerge Then
            For n = 0 To UBound(Cols)
                .Columns(Cols(n)).Merge
            Next n
        Else
            For n = 0 To UBound(Cols)
                .Columns(Cols(n)).UnMerge
            Next n
        End If
    End With
End Sub
user_98140690
Related