Макрос VBA Excel (Поднять выделенную часть строки на позицию вверх)

[ПланктонOffice'ный]

Вопрос такой, как поднять выделенный участок строки на позицию вверх? Есть макрос, который поднимает всю строку, ячейка которой на данный момент выделена, а мне нужно поднять не всю строку, а ее часть, чтобы не задеть таблицу, которая находится справа от той в которой я работаю.

К примеру:

| 1| 2| 3| 4| ...... | 1| 1| 1|
| 2| 3| 4| 5| ...... | 2| 2| 2|
| 3| 4| 5| 6| ...... | 3| 3| 3|
| 4| 5| 6| 7| ...... | 4| 4| 4|

Нужно привести к такому виду: (не трогая ячейки в правой стороне)

| 1| 2| 3| 4| ...... | 1| 1| 1|
| 2| 3| 4| 5| ...... | 2| 2| 2|
| 4| 5| 6| 7| ...... | 3| 3| 3|
| 3| 4| 5| 6| ...... | 4| 4| 4|

Макрос который поднимает всю строку, выглядит так:

Sub stringUP()
If ActiveCell.Row > 1 Then
ActiveCell.Offset(0, 0).EntireRow.Cut
ActiveCell.Offset(-1, 0).EntireRow.Insert
ActiveCell.Offset(-1, 0).Activate
End If
End Sub

Макрос меняющий местами 2 одинаковых диапазона местами выглядит так:

Sub SwapRanges()
Dim ra As Range: Set ra = Selection
msg1 = "Надо выделить 2 диапазона ячеек одинакового размера"
msg2 = "Надо выделить 2 диапазона ячеек одинакового размера"
If ra.Areas.Count <> 2 Then MsgBox msg1, vbCritical, "Ошибка": Exit Sub
If ra.Areas(1).Count <> ra.Areas(2).Count Then MsgBox msg2, vbCritical, "Ошибка": Exit Sub
arr2 = ra.Areas(2).Value
ra.Areas(2).Value = ra.Areas(1).Value
ra.Areas(1).Value = arr2
End Sub

А решить мой вопрос, у меня не хватает интелекта. помогите пожалуйста.

[EducatedFool]

К примеру, вам надо «поднять» диапазон ячеек b4:e4
Для этого надо «вырезать» (удалить) вышестоящий диапазон ячеек b3:e3
Делается это так:

[b3:e3].Delete

Для активной ячейки это будет выглядеть примерно так:

Activecell.Resize(,3).Delete Shift:=xlUp

[ПланктонOffice'ный]

Спасибо за оперативность, но мне нужно поднять выделенный (не всегда одинаковыый) диапазон.

[EducatedFool]

А если подключить фантазию, и поэкспериментировать?

Sub test1()
    On Error Resume Next
    ' поднимаем на столько строк, сколько выделено
    Selection.Offset(-1 * Selection.Rows.Count).Delete
End Sub

Sub test2()
    On Error Resume Next
    ' поднимаем на одну строку
    Selection.Offset(-1).Resize(1).Delete
End Sub

[DiemonStar]

К примеру:

| 1| 2| 3| 4| ...... | 1| 1| 1|
| 2| 3| 4| 5| ...... | 2| 2| 2|
| 3| 4| 5| 6| ...... | 3| 3| 3|
| 4| 5| 6| 7| ...... | 4| 4| 4|

Нужно привести к такому виду: (не трогая ячейки в правой стороне)

| 1| 2| 3| 4| ...... | 1| 1| 1|
| 2| 3| 4| 5| ...... | 2| 2| 2|
| 4| 5| 6| 7| ...... | 3| 3| 3|
| 3| 4| 5| 6| ...... | 4| 4| 4|

судя по примеру, Вам нужно переставить местами два соседних одинаковых диапазона:

'Замена с верхним
Sub ChangeUp
Selection.Cut
Selection.Offset(-1*Selection.Rows.Count).Insert Shift:=xlDown
End Sub
'Замена с нижним
sub ChangeDown
Selection.Cut
Selection.Offset(Selection.Rows.Count).Insert Shift:=xlUp
end sub

з.ы. Можете поставить проверку на достаточное количество строк вверху для обмена