Merge Every 3 Rows In Row 1

Question

I am trying to merge every 3 cells of row 1 (starting with B1, and the last cell to be merged is FY - meaning FW, FX & FY should be merged.). I have used this to merge every 3 rows going down a column, but how would I alter this to go across row 1?

Function MergeHeaders()
Application.DisplayAlerts = False

Dim RgToMerge As Range

For i = 3 To ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row Step 3

Set RgToMerge = Range(Cells(i, 3), Cells(i + 1, 3))
With RgToMerge
    .Merge
    .HorizontalAlignment = xlCenterAcrossSelection
    .VerticalAlignment = xlCenter
End With

Next i
End Function

Your code only merges 2 rows together, not 3. And moves down Col C...you want it to merge 3 Rows together but move across the row and merge every third column? — Rdster, Dec 08 '16 at 15:48
Starting in B1, I want to merge, B1, C1, D1, then merge E1, F1, G1 all the way down to the last that should be merged are FW, FX, FY — SmallFries BigGuys, Dec 08 '16 at 15:50

score 3 · Accepted Answer · answered Dec 08 '16 at 15:54

Something more like this?

Function MergeHeaders()
Dim RgToMerge As Range

  Application.DisplayAlerts = False

  For i = 2 To ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column Step 3
    Set RgToMerge = Range(Cells(1, i), Cells(1, i + 2))
    With RgToMerge
      .Merge
      .HorizontalAlignment = xlCenterAcrossSelection
      .VerticalAlignment = xlCenter
    End With
  Next i
End Function

Merge Every 3 Rows In Row 1

1 Answers1