Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(Target, Range("A:A")) Is Nothing Then
  Application.OnKey "^{DOWN}"
  Else
  Application.OnKey "^{DOWN}", "ShowForm"
  End If
End Sub
Private Sub Worksheet_Activate()
  If Not Intersect(ActiveCell, Range("A:A")) Is Nothing Then
  Application.OnKey "^{DOWN}", "ShowForm"
  End If
End Sub
Private Sub Worksheet_Deactivate()
  Application.OnKey "^{DOWN}"
End Sub 

  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Intersect(Target, Range("B:B")) Is Nothing Then
  Application.OnKey "^{DOWN}"
  Else
  Application.OnKey "^{DOWN}", "ShowForm2"
  End If
End Sub
Private Sub Worksheet_Activate()
  If Not Intersect(ActiveCell, Range("B:B")) Is Nothing Then
  Application.OnKey "^{DOWN}", "ShowForm2"
  End If
End Sub
Private Sub Worksheet_Deactivate()
  Application.OnKey "^{DOWN}"
End Sub

Public s As Range

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim r1 As Range, r2 As Range, r3 As Range, s As String
    If Not Sh.Name Like "ТК*" Then Exit Sub
    Set r1 = [C31:C54]: Set r2 = [C57:C80]: Set r3 = [C83:C106]
    If Intersect(Target, Union(r1, r2, r3)) Is Nothing Then Exit Sub
    Select Case 0
    Case Is < Application.CountA(r3): s = "$A$1:$T$106"
    Case Is < Application.CountA(r2): s = "$A$1:$T$80"
    Case Is < Application.CountA(r1): s = "$A$1:$T$54"
    Case Else: s = "$A$1:$T$28"
    End Select
    ActiveSheet.PageSetup.PrintArea = s
End Sub

Public s As Range
Sub Copy()
Application.ScreenUpdating = False
Set s = Selection
s.Copy
Range("N2:S2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
s.ClearContents
Selection.Copy
s.Select
     End Sub
Sub Paste()
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("N2:S22").ClearContents
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Range("X3")
Case 10000: s = "ЛКб!$A$1:$Q$22"
Case 2000: s = "ЛКб!$A$23:$Q$44"
Case 300: s = "ЛКб!$A$45:$Q$66"
Case 40: s = "ЛКб!$A$67:$Q$88"
Case 5: s = "ЛКб!$A$89:$Q$110"
Case 12000: s = "ЛКб!$A$1:$Q$44"
Case 12300: s = "ЛКб!$A$1:$Q$66"
Case 12340: s = "ЛКб!$A$1:$Q$88"
Case 12345: s = "ЛКб!$A$1:$Q$110"
Case 2300: s = "ЛКб!$A$23:$Q$66"
Case 2340: s = "ЛКб!$A$23:$Q$88"
Case 2345: s = "ЛКб!$A$23:$Q$110"
Case 340: s = "ЛКб!$A$45:$Q$88"
Case 345: s = "ЛКб!$A$45:$Q$110"
Case 45: s = "ЛКб!$A$67:$Q$110"
End Select
Me.PageSetup.PrintArea = s 'эта строка выделена желтым
End Sub

Public s As Range
Sub Copy()
Application.ScreenUpdating = False
Set s = Selection
s.Copy
Range("N2:S2").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
s.ClearContents
Selection.Copy
s.Select
     End Sub
Sub Paste()
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("N2:S22").ClearContents
End Sub