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

以下代码的问题：它对所有工作表的Range（“ C1”）起作用！
您可能要使用命名范围或限制可能的工作表数
（例如，最小工作表数= 2，要复制的模板是工作表2，
仅工作表1具有Worksheet_Change代码

Sheet1：

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

是否可以在不使用按钮的情况下使单元格值添加或删除单元格范围或工作表的副本

1 个答案: