excel - 删除从第一个开始的第二个工作表(所以 1、3、5...)

Question

我目前正在使用来自 Kutools 的 VBA 代码，它可以让我将所有工作表组合成一个组合的“主”表。但是，每个相关的工作表前面都有一个不相关的工作表，应该也不能合并。所以我需要先删除工作表 1,3,5... 才能使代码正常工作。
或者，忽略这些工作表并仅组合所有其他工作表(2、4、6 ...)也可以。
这是我使用的 VBA 代码:

    Sub Combine()
'UpdateByKutools20151029
    Dim i As Integer
    Dim xTCount As Variant
    Dim xWs As Worksheet
    On Error Resume Next
LInput:
    xTCount = Application.InputBox("The number of title rows", "", "1")
    If TypeName(xTCount) = "Boolean" Then Exit Sub
    If Not IsNumeric(xTCount) Then
        MsgBox "Only can enter number", , "Kutools for Excel"
        GoTo LInput
    End If
    Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
    xWs.Name = "Combined"
    Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1")
    For i = 2 To Worksheets.Count
        Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy _
               Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1)
    Next
End Sub

谢谢你的帮助!

Answer 1

通常，当我们从集合中删除项目时，我们会向后迭代以避免项目从其原始位置移动。在这里，我创建了一个包含所有奇数工作表名称的数组，并使用它在一次操作中删除它们。

Sub ReplaceOddWorksheets()
    Const Delimiter As String = "\"
    Dim SheetNames As String
    Dim n As Long
    For n = 1 To Worksheets.Count Step 2
        SheetNames = SheetNames & Delimiter & Worksheets(n).Name
    Next
    SheetNames = Mid(SheetNames, 2)
    
    Application.DisplayAlerts = False
    Sheets(Split(SheetNames, Delimiter)).Delete
    Application.DisplayAlerts = True
End Sub