Выделения относительно активной ячейки

Выделить вниз до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Down)

Sub CtrlShiftDown()

Range(ActiveCell, ActiveCell.End(xlDown)).Select

End Sub

Выделить вверх до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Up)

Sub CtrlShiftUp()

Range(ActiveCell, ActiveCell.End(xlUp)).Select

End Sub

Выделить вправо до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Right)

Sub CtrlShiftRight()

Range(ActiveCell, ActiveCell.End(xlToRight)).Select

End Sub

Выделить влево до первой или последней заполненной ячейки (равносильно нажатию Ctrl+Shift+Left)

Sub CtrlShiftLeft()

Range(ActiveCell, ActiveCell.End(xlToLeft)).Select

End Sub

Выделить текущую область (выделяется диапазон неразрывно заполненных ячеек - равносильно нажатию кнопок Ctrl+Shift+*)

Sub CtrlShiftUmn()

ActiveCell.CurrentRegion.Select

End Sub

Выделить активную область (происходит выделение всего заполненного диапазона Ctrl+Shift+Home, End, Home)

Sub CtrlShiftHome()

Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

End Sub

Выделить смежные (заполненные прилегающие к активной ячейке) ячейки в столбце с активной ячейкой

Sub SelectActiveColumn()

Dim TopCell As Range

Dim BottomCell As Range

If IsEmpty(ActiveCell) Then Exit Sub

On Error Resume Next

If IsEmpty(ActiveCell.Offset(-1, 0)) Then Set TopCell = _

ActiveCell Else Set TopCell = ActiveCell.End(xlUp)

If IsEmpty(ActiveCell.Offset(1, 0)) Then Set BottomCell = _

ActiveCell Else Set BottomCell = ActiveCell.End(xlDown)

Range(TopCell, BottomCell).Select

End Sub

Выделить смежные ячейки в строке с активной ячейкой

Sub SelectActiveRow()

Dim LeftCell As Range

Dim RightCell As Range

If IsEmpty(ActiveCell) Then Exit Sub

On Error Resume Next

If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = _

ActiveCell Else Set LeftCell = ActiveCell.End(xlToLeft)

If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = _

ActiveCell Else Set RightCell = ActiveCell.End(xlToRight)

Range(LeftCell, RightCell).Select

End Sub

Выделить весь активный столбец

Sub SelectionEntireColumn()

Selection.EntireColumn.Select

End Sub

Выделить всю активную строку

Sub SelectEntireRow()

Selection.EntireRow.Select

End Sub

Выделить рабочий лист

Sub SelectEntireSheet()

Cells.Select

End Sub

Выделить следующую пустую ячейку снизу

Sub CellNextDown()

ActiveCell.Offset(1, 0).Select

Do While Not IsEmpty(ActiveCell)

ActiveCell.Offset(1, 0).Select

Loop

End Sub

Выделить следующую пустую ячейку справа

Sub CellNextRight()

ActiveCell.Offset(0, 1).Select

Do While Not IsEmpty(ActiveCell)

ActiveCell.Offset(0, 1).Select

Loop

End Sub

Выделение от первой непустой до последней непустой ячеек в строке

Sub SelectFirstToLastInRow()

Dim LeftCell As Range

Dim RightCell As Range

Set LeftCell = Cells(ActiveCell.Row, 1)

Set RightCell = Cells(ActiveCell.Row, 256)

If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End(xlToRight)

If IsEmpty(RightCell) Then Set RightCell = RightCell.End(xlToLeft)

If LeftCell.Column = 256 And RightCell.Column = 1 Then ActiveCell. _

Select Else Range(LeftCell, RightCell).Select

End Sub

Выделение от первой непустой до последней непустой ячеек в столбце

Sub SelectFirstToLastInColumn()

Dim TopCell As Range

Dim BottomCell As Range

Set TopCell = Cells(1, ActiveCell.Column)

Set BottomCell = Cells(16384, ActiveCell.Column)

If IsEmpty(TopCell) Then Set TopCell = TopCell.End(xlDown)

If IsEmpty(BottomCell) Then Set BottomCell = BottomCell.End(xlUp)

If TopCell.Row = 16384 And BottomCell.Row = 1 Then ActiveCell. _

Select Else Range(TopCell, BottomCell).Select

End Sub