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

Выделить вниз до первой или последней заполненной ячейки (равносильно нажатию 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