Можно ли добавлять или удалять значения ячеек из диапазонов ячеек или рабочих таблиц без использования кнопки?

Question

Я пытаюсь сделать так, чтобы значение ячейки определяло, сколько копий нужно сделать.Я пытаюсь сделать это, если значение ячейки уменьшится, чтобы удалить листы, которые выше, чем значение.У меня в настоящее время есть добавление, работающее без проблем, просто не могу понять, как заставить его удалять копии, когда значение становится меньше.Я полагаю, что я могу заставить кнопку сделать проверку, просто пытаясь сделать ее более автоматизированной.

Sub CreateDistro()
    Dim i As Long
    Dim Num As Integer
    Dim Name As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set ActiveSheet = ActiveSheet
    Num = Range("C1")
    If Num > 1 Then
        For i = 1 To Num
            Name = ActiveSheet.Name
            xActiveSheet.Copy After:=ActiveWorkbook.Sheets(Name)
            ActiveSheet.Name = "Distro-" & i
        Next
    End If
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End Sub

Answer 1

Проблема кода ниже: он реагирует на диапазон ("C1") всех листов!Возможно, вы захотите использовать именованный диапазон или ограничить количество возможных листов(например, минимальное количество листов = 2, шаблон для копирования - это лист 2,только лист1 имеет код Worksheet_Change.

Лист1:

Option Explicit

Private Sub Worksheet_Change(ByVal target As Range)
    Call ChangeSheets(target)
End Sub

Модуль 1:

Option Explicit

Sub ChangeSheets(ByVal target As Range)
    Dim iCt As Integer
    Dim Num As Integer
    Dim maxSh As Integer

    'If Not Intersect(Target, Range("C1")) Is Nothing Then
    '    MsgBox ("C1: " & Target.Value)
    'End If

    If target.Value <= 0 Then
        MsgBox "Minimum worksheet count = 1!" & vbCrLf & "Nothing to do!"
        Application.EnableEvents = False
        target.Value = 1
        Application.EnableEvents = True
        Application.DisplayAlerts = False
        maxSh = Sheets.Count
        For iCt = maxSh To 2 Step -1
            Sheets(iCt).Delete
        Next iCt
        Application.DisplayAlerts = True
        Exit Sub
    End If

    If Worksheets.Count = target.Value Then
        MsgBox "Worksheet count = " & target.Value & vbCrLf & "Nothing to do!"
        Exit Sub
    End If

    'add some sheets
    If Worksheets.Count < target.Value Then
        Num = target.Value - Worksheets.Count
        For iCt = 1 To Num
            ActiveSheet.Copy After:=Sheets(Sheets.Count)
        Next iCt
        Exit Sub
    End If

    'delete some sheets
    If Worksheets.Count > target.Value Then
        Num = Worksheets.Count - target.Value
        Application.DisplayAlerts = False
        maxSh = Sheets.Count
        For iCt = 0 To Num - 1
            Debug.Print maxSh - iCt; ": "; Sheets(maxSh - iCt).Name
            Sheets(maxSh - iCt).Delete
        Next iCt
        Application.DisplayAlerts = True
        Exit Sub
    End If
End Sub