根据单元格值复制和删除工作表

Question

我从用户名 @Ike 获得了复制和删除单元格的帮助。当我单击基于图像的按钮时，将创建一些新工作表并命名（基于它在单元格中指示的单元格值） - 示例：A1、A2、B1...，它将复制工作表 6.1。

分享的代码运行得非常好。代码如下所示：

如果阶段范围内有一个值并且该值尚不存在，则此操作会添加一张工作表 - 通过使用existsSheet函数

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

我现在面临的问题是，当我有新工作表时，比如说工作表 8，并且该工作表位于工作表 6.1 之后。当我单击“复制和删除工作表”按钮时，上面的代码将起作用，但它将删除我新创建的工作表名称“Sheet 8”。

需要一些帮助。 TQ

Answer 1

问题是

sht1 and sht2

在点击事件中被硬编码，当调用

checkSheetsForPhase

时，

Sheet8

被删除。

更正的做法如下：

• 假设工作簿中存在

  Sheet8 has the same data layout as 

  Sheet6

  , and ensure that 

  Sheet8.x`。

• 适当更新

  sht1

  和

  sht2

  的对象引用。

Public Sub RectangleRoundedCorners6_Click()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Set sh1 = ActiveSheet.Next
    Set sh2 = ActiveSheet
    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