如何添加代码以自动删除多余的工作表？
如何添加代码以自动删除多余的工作表？
提问于 2021-01-14 21:31:21
在@clomee的帮助下，非常感谢，我现在有这个代码。它允许我在单元格中输入一个特定的数字，它会复制我的模板窗口工作表，这样我就可以为每个工作表中的每一个输入单独的尺寸和规格。
下面的代码允许我输入6no，通过稍后将其更改为8，它将只复制模板2倍，而不是添加8个额外的副本。
我需要以某种方式给它添加另一个函数，所以如果我将单元格中的"8“替换为5，它将向后计数，并删除名称中数字>5的所有工作表。
这可能是简单的代码，但多亏了我在这里得到的帮助和答案，我才能走到这一步，并简化了我一开始的工作。
非常感谢!
Private Sub Worksheet_Change(ByVal target As Excel.Range)
If target.Cells.Count = 0 Then Exit Sub
If IsNumeric(target) And target.Address = "$B$4" Then
Select Case target.Value
Case 1 To 50: copierW
End Select
End If
End Sub
Sub copierW()
Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, x As Integer
Set sh1 = Sheets("Main")
Set sh2 = Sheets("W-Template")
Set wh = Sheets("Reference")
x = ActiveSheet.Range("b4")
Count = 0
For Each sh In Worksheets
If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
Count = Count + 1
End If
Next sh
needed_copies = x - Count
For numtimes = 1 To needed_copies
ActiveWorkbook.Sheets("W-Template").Copy _
After:=ActiveWorkbook.Sheets("Main")
Count2 = Count + numtimes
ActiveSheet.Name = "W" & Count2 & "."
Next
Worksheets(1).Select
End Sub`回答 2
Stack Overflow用户
回答已采纳
发布于 2021-01-14 22:04:27
下面的代码删除所有在"W“之后包含更高数字作为x值的纸张。
Sub copierW()
Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, x As Integer
Set sh1 = ThisWorkbook.Worksheets("Main")
Set sh2 = ThisWorkbook.Worksheets("W-Template")
Set wh = Sheets("Reference")
x = sh1.Cells(4, 2).Value
count = 0
For Each sh In Worksheets
If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
count = count + 1
End If
Next sh
needed_copies = x - count
If needed_copies < 0 Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." And x < Left(Right(sh.Name, Len(sh.Name) - 1), Len(sh.Name) - 2) Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(sh.Name).Delete
Application.DisplayAlerts = True
End If
Next sh
Else
For numtimes = 1 To needed_copies
ActiveWorkbook.Sheets("W-Template").Copy _
After:=ActiveWorkbook.Sheets("Main")
Count2 = count + numtimes
ActiveSheet.Name = "W" & Count2 & "."
Next
End If
Worksheets(1).Select
End SubStack Overflow用户
发布于 2021-01-14 22:02:34
这应该可以做你想要的事情。
我声明了未声明的变量，并将x更改为long (不要使用整数)。
Option Explicit
Private Sub Worksheet_Change(ByVal target As Excel.Range)
If target.Cells.count = 0 Then Exit Sub
If IsNumeric(target) And target.Address = "$B$4" Then
Select Case target.Value
Case 1 To 50: copierW
End Select
End If
End Sub
Sub copierW()
Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, wh As Worksheet, x As Long
Dim count As Long, needed_copies As Long, numtimes As Long, count2 As Long
Set sh1 = Sheets("Main")
Set sh2 = Sheets("W-Template")
Set wh = Sheets("Reference")
x = ActiveSheet.Range("b4")
count = 0
For Each sh In Worksheets
If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
count = count + 1
End If
Next sh
needed_copies = x - count
If needed_copies < 0 Then
Application.DisplayAlerts = False
For Each sh In Worksheets
If Left(sh.Name, 1) = "W" And Right(sh.Name, 1) = "." Then
If Mid(sh.Name, 2, Len(sh.Name) - 1) > x Then
sh.Delete
End If
End If
Next sh
Application.DisplayAlerts = True
Else
For numtimes = 1 To needed_copies
ActiveWorkbook.Sheets("W-Template").Copy _
After:=ActiveWorkbook.Sheets("Main")
count2 = count + numtimes
ActiveSheet.Name = "W" & count2 & "."
Next
End If
Worksheets(1).Select
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/65719954
复制相关文章
相似问题
腾讯云开发者
