Absolutely, this requirement is fully achievable with VBA! The key challenge here is avoiding skipped merged regions after inserting rows—we’ll solve this by looping from the bottom of the sheet up to the top, then expanding each paired merged cell into a 5-row merged range.

Approach Overview #

Here’s the core logic we’ll implement:

• Bottom-up looping: Inserting rows shifts all lower cells down, so processing from the last merged region to the first ensures we don’t miss any pairs.
• Insert & merge: For each existing 2-row merged region, we’ll add 3 rows right after it, then merge those new rows with the original range to create a 5-row merged cell.

Full VBA Code #

Sub ExpandMergedCellsToFive()
    Dim ws As Worksheet
    Dim mergedRng As Range
    Dim lastRow As Long
    Dim i As Long
    
    ' Set your target worksheet (replace "Sheet1" with your actual sheet name)
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Disable screen updates to speed up execution and avoid flickering
    Application.ScreenUpdating = False
    
    ' Find the last row with data in column B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' Loop from bottom to top to prevent skipping merged regions after row inserts
    For i = lastRow To 2 Step -1
        ' Check if current cell is part of a merged range
        If ws.Cells(i, "B").MergeCells Then
            Set mergedRng = ws.Cells(i, "B").MergeArea
            
            ' Only process paired merged cells (exactly 2 rows)
            If mergedRng.Rows.Count = 2 Then
                ' Insert 3 rows immediately after the merged range
                mergedRng.Offset(mergedRng.Rows.Count).Resize(3).Insert Shift:=xlDown
                
                ' Resize the merged range to include new rows and re-merge
                mergedRng.Resize(mergedRng.Rows.Count + 3).Merge
            End If
        End If
    Next i
    
    ' Re-enable screen updates
    Application.ScreenUpdating = True
    
    MsgBox "Expansion completed successfully!", vbInformation
End Sub

Key Notes & Precautions #

• Sheet name adjustment: Replace "Sheet1" in the code with your actual worksheet name.
• Test first: Always run this on a copy of your worksheet to avoid accidental data loss—inserting rows will shift all content below the merged regions down.
• Non-paired merged cells: The code checks for exactly 2-row merged ranges, so it won’t affect any other merged cells you might have in column B.
• Performance: Disabling screen updating drastically speeds up the process, especially if you have a large number of merged pairs.

How to Use #

1. Open your Excel file.
2. Press Alt + F11 to open the VBA Editor.
3. Right-click your workbook in the Project Explorer > Insert > Module.
4. Paste the code into the new module.
5. Adjust the sheet name if needed.
6. Press F5 to run the macro, or assign it to a button for easier access later.

内容的提问来源于stack exchange，提问作者mabanger