Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:E" & Cells(Rows.Count, 1).End(xlUp).Row)) Is Nothing Then
rw = Target.Row
If Selection.Address = "$A$" & rw & ":$M$" & rw Then
With Sheets("Для бухг")
Selection.copy .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
Beep
End With
End If
End If
End Sub
Dim Coord_Selection As Boolean 'глобальная переменная для вкл/выкл выделения
Код
Sub Selection_On() 'макрос включения выделения
Coord_Selection = True
End Sub
Sub Selection_Off() 'макрос выключения выделения
Coord_Selection = False
End Sub
'основная процедура, выполняющая выделение
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim WorkRange As Range
If Target.Cells.Count > 1 Then Exit Sub 'если выделено больше 1 ячейки - выходим
If Coord_Selection = False Then Exit Sub 'если выделение выключено - выходим
Application.ScreenUpdating = False
Set WorkRange = Range("A1:AU10000") 'адрес рабочего диапазона, в пределах которого видно выделение
Intersect(WorkRange, Union(Target.EntireColumn, Target.EntireRow)).Select 'формируем крестообразный диапазон и выделяем
Target.Activate
End Sub
