Как и в каком указать диапазон объединенных ячеек в VBA?

Question

[dflbrhekbn]

Есть макрос который автоматически подбирает высоту объединенных ячеек по мере его заполнения и скрывает те в которых вообще нечего нету. Как и в каком месте указать диапазон конкретных объединенных ячеек ячеек, а не все ячейки на листе ?

Sub Ìàêðîñ1()
'
' Ìàêðîñ1 Ìàêðîñ
'

'
    Rows("5:7").RowHeight = 0
    Range("A4:C7").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A8").Select
    Rows("7:7").EntireRow.AutoFit
    Rows("6:6").EntireRow.AutoFit
    Rows("5:5").EntireRow.AutoFit
    Rows("4:4").EntireRow.AutoFit
    Rows("7:7").RowHeight = 14.25
End Sub
Sub Ìàêðîñ2()
'
' Ìàêðîñ2 Ìàêðîñ
'

'
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
      
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub
Sub Ìàêðîñ3()
'
' Ìàêðîñ3 Ìàêðîñ
'

'
    Range("A4:C7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
End Sub


Sub test()
On Error Resume Next
Application.ScreenUpdating = False
Dim coll As New Collection
Dim iRange As Range
Dim iCell As Range
Set iRange = ActiveSheet.UsedRange
For Each iCell In iRange
If iCell.MergeCells Then
coll.Add iCell.MergeArea.Address, iCell.MergeArea.Address
If Err.Number = 0 Then
If iCell.Value = "" Then
iCell.MergeArea.RowHeight = 0
Else
y = iCell.MergeArea.ColumnWidth
Set sh = Sheets.Add
With sh.Cells(1, 1)
  .HorizontalAlignment = iCell.MergeArea.HorizontalAlignment
  .VerticalAlignment = iCell.MergeArea.VerticalAlignment
  .WrapText = True
  .ColumnWidth = y * iCell.MergeArea.Columns.Count
  .Value = iCell.Value
  .EntireRow.AutoFit
  x1 = .RowHeight
End With
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
iCell.MergeArea.RowHeight = x1 / iCell.MergeArea.Rows.Count
End If
Else
Err.Clear
End If
End If
Next
Application.ScreenUpdating = True
End Sub

Answer 1

[idShura]

Не до конца понял вопрос. Диапазон ячеек которые обрабатываются указан в строке Set iRange = ActiveSheet.UsedRange