基于单元格复制和删除工作表

Question

我已经根据下面的代码创建了添加按钮来添加新工作表：

Sub RectangleRoundedCorners6_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim c As Range
Set sh1 = Sheets("6.1")
Set sh2 = Sheets("6")
With Sheets("6")
For Each c In .Range("C8:C" & .Cells(Rows.Count, 1).End(xlUp).Row)
specifictext = "Insert"
        sh1.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value
    Next
    End With
End Sub

它的工作原理基于下图，当我单击按钮时，新工作表已添加到 C 列单元格中的值后面。

现在我想要两件事：

1. 如果我第二次单击该按钮，如果基于 C 列名称的工作表已经存在，我希望什么也不会发生。因为现在，当我点击按钮时，会弹出“运行时错误 1004：该名称已被占用。请尝试使用其他名称。

2. 当我删除引用单元格 C12 的值“D1”时，我希望在单击按钮时也删除工作表 D1。我删除该值对单元格没有影响。

如果真的很感激，请提供帮助。谢谢你。

Answer 1

您将需要一些辅助潜艇来实现这一目标：

此操作会添加一张工作表（如果尚不存在） - 通过使用

existsSheet

-function

Public Sub addSheetsIfNotExists(wsSourceToCopy As Worksheet, arrValidPhases As Variant)

Dim newSheetName As String

Dim i As Long
For i = 1 To UBound(arrValidPhases, 1)
    newSheetName = arrValidPhases(i, 1)
    If newSheetName <> "" Then
        If existsSheet(newSheetName) = False Then
            With ThisWorkbook
                wsSourceToCopy.Copy after:=.Worksheets(.Worksheets.Count)
                ActiveSheet.Name = newSheetName
            End With
        End If
    End If
Next
End Sub

Private Function existsSheet(SheetNameToCheck As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(SheetNameToCheck)
If Not ws Is Nothing Then existsSheet = True
End Function

如果一张纸不存在于阶段范围内，则此操作会将其删除：

Public Sub checkSheetsForPhase(wsStartToCheck As Worksheet, arrValidPhases As Variant)
Dim ws As Worksheet, i As Long, fExists As Boolean
For Each ws In ThisWorkbook.Worksheets
    If ws.Index > wsStartToCheck.Index Then
        fExists = False
        For i = 1 To UBound(arrValidPhases, 1)
            If ws.Name = arrValidPhases(i, 1) Then
                fExists = True
                Exit For
            End If
        Next
        If fExists = False Then
            Application.DisplayAlerts = False
                ws.Delete
            Application.DisplayAlerts = True
        End If
    End If
Next
End Sub

您将从点击事件中调用这些子程序，如下所示：

Public Sub RectangleRoundedCorners6_Click()()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Sheets("6.1")
Set sh2 = Sheets("6")

Dim arrPhases As Variant

With sh2
    arrPhases = .Range("C8:C" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
End With

addSheetsIfNotExists sh1, arrPhases
checkSheetsForPhase sh1, arrPhases

sh2.Activate
End Sub