Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
    Dim shn As Worksheet
    If Target.Count > 1 Then Exit Sub
    If Not IsNumeric(Target) Then Exit Sub
    mask_ = "Ящик"
    If sh.Name = mask_ Then
        If Target.Address(0, 0) = "B1" Then
            On Error Resume Next
            zt_ = CByte(Target.Value)
            If Err Then Exit Sub
            On Error GoTo 0
            For Each shn In Me.Worksheets
                With shn
                    If IsNumeric(Right(shn.Name, 1)) Then
                        nom_ = CByte(Replace(shn.Name, mask_ & " ", ""))
                        If nom_ > zt_ Then
                            Application.DisplayAlerts = 0
                            .Delete
                            Application.DisplayAlerts = 1
                        Else
                           If nom_ > nom1_ Then
                    nom1_ = nom_
                           End If
                        End If
                    End If
                End With
            Next shn
            If zt_ > nom1_ Then
                Application.ScreenUpdating = 0
                Application.EnableEvents = 0
                For i = nom1_ + 1 To zt_
                    sh.Copy After:=Sheets(ThisWorkbook.Sheets.Count)
                    Set shn = ActiveSheet
                    With shn
                        .Range("A1:B2").Clear
                        .Range("A3") = mask_ & " №" & i
                        .Name = mask_ & " " & i
                    End With
                Next i
                sh.Select 'если переход обратно на текущий лист не нужен, то уберите эту строку
                Application.EnableEvents = 1
                Application.ScreenUpdating = 1
            End If
        End If
    End If
End Sub