Sub РамкиSet(rg As Range)
  Dim b&
  With rg
  For b = 7 To 10: .Borders(b).Weight = xlThin: Next
  End With
End Sub

Sub РамкиClear(rg As Range)
  Dim b&
  With rg
  For b = 7 To 10: .Borders(b).LineStyle = xlNone: Next
  End With
End Sub

Sub test()
  Dim rg As Range
  Set rg = [c4:h10]
  РамкиSet rg
  MsgBox "Видите рамку у диапазона: " & rg.Address(0, 0) _
  & vbLf & "жмите ОК - и она будет удалена))"
  РамкиClear rg
End Sub

fn = dir("d:\*полезная*.*")
if fn <> "" then
Set wbCopy = Workbooks.Open("D:\" & fn, False, False)

Sub Sort1()
  Sort "Лист1", 8
End Sub
 
 
Sub Sort2()
  Sort "Лист2", 9
End Sub


Sub Sort(ShNm$, C&)
  Dim rg As Range, ws
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  If ShNm = ActiveSheet.Name Then
    Set rg = ActiveCell
  Else
    Set ws = ActiveSheet: Worksheets(ShNm).Activate: Set rg = ActiveCell
    ws.Activate
  End If
  Dim Sh As Range, iLastRow&
  With ActiveWorkbook.Worksheets(ShNm)
    iLastRow& = .Cells(.Rows.Count, C).End(xlUp).Row
    If iLastRow < 5 Then Exit Sub
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=.Range("D5:D" & iLastRow), _
      SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .Sort.SetRange .Range("B5:" & Left(Cells(1, C).Address(0, 0), 1) & iLastRow)
    With .Sort
      .Header = xlGuess: .MatchCase = False
      .Orientation = xlTopToBottom: .SortMethod = xlPinYin: .Apply
    End With
  End With
  If rg.Parent.Name = ActiveSheet.Name Then
    rg.Select
  Else
    Worksheets(ShNm).Activate: rg.Select: ws.Activate
  End If
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

=--([@Столбец2]-ИНДЕКС(A:A;МАКС(ЕСЛИ($B$2:B2=1;СТРОКА($B$2:B2))))>1/12) 

=--([@Столбец2]-A2>1/12)

.LeftFooter = [X4] & ", общее количество страниц" & [E7] & ", страница &P"