Диапазоны ячеек НЕсмежные

Private Sub Диапазон_НЕсмежный_Сместить_test()
    Dim rng As Range
    Set rng = Selection
 
    Set rng = Диапазон_НЕсмежный_Сместить(rng, 2, -2)
    rng.Select
End Sub
 
Public Function Диапазон_НЕсмежный_Сместить(rng As Range, _
                                            iRow As Long, iCol As Long) As Range
 
    If rng Is Nothing Then MsgBox4Debug "rng Is Nothing ", "Диапазон_НЕсмежный_Сместить"
 
    Dim x As Long, rng_Off As Range
 
    With rng.Areas
 
        For x = 1 To .Count
            Set rng_Off = App_Union(rng_Off, _
                                    .Item(x).Offset(iRow, iCol))
        Next
    End With
 
    Set Диапазон_НЕсмежный_Сместить = rng_Off
End Function
 
Private Sub Диапазон_НЕсмежный_Столбцы_test()
    Dim rng As Range
    Set rng = Selection
 
    Set rng = Диапазон_НЕсмежный_Столбцы(rng, 2)
    rng.Select
End Sub
 
Public Function Диапазон_НЕсмежный_Столбцы(rng As Range, _
                                           iCol As Long) As Range
' изменить количество столбцов в диапазоне
    If rng Is Nothing Then MsgBox4Debug "rng Is Nothing ", "Диапазон_НЕсмежный_Столбцы"
 
    Dim iRow As Long
    Dim x As Long, rng_Off As Range
 
    With rng.Areas
 
        For x = 1 To .Count
            iRow = .Item(x).Rows.Count
            Set rng_Off = App_Union(rng_Off, _
                                    .Item(x).Resize(iRow, iCol))
        Next
    End With
 
    Set Диапазон_НЕсмежный_Столбцы = rng_Off
End Function
 
Public Function App_Union(rng_Union As Range, _
                          ByVal rng As Range) _
                          As Range    ' InExSu
' Range Union, объединение диапазонов
' Для упрощения чтения кода
' вызов: Set rng_union = App_Union(rng_union, .Rows(x))
 
'    If rng_union.Parent.Name <> rng.Parent.Name Then MsgBox4Debug
 
    If Not rng_Union Is Nothing Then
        ' If rng_Union.Parent.Name <> rng.Parent.Name Then MsgBox4Debug
        Set rng_Union = Application.Union(rng_Union, rng)
    Else
        Set rng_Union = rng
    End If
 
    Set App_Union = rng_Union
End Function