Delete every second worksheet starting with the first (so 1, 3, 5...)

Question

I am currently using a VBA code from Kutools that lets me combine all my worksheets into one combined "Master" sheet. However, every relevant worksheet is preceded by an irrelevant one that should and cannot be combined. So I need to first delete worksheets 1,3,5... in order for the code to work.

Alternatively, ignoring those worksheets and combining only every other worksheet (2,4,6...) would also work.

This is the VBA code Im using:

    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

Thanks for your help!

Answer 1

Copy Data From Every Other Worksheet

Sub CombineEveryOtherWorksheet()

    Const wsName As String = "Combined"
    
    Dim hrCount As Variant
    Dim msg As Long
    
    Do
        hrCount = Application.InputBox("The number of title rows", "", "1")
        If TypeName(hrCount) = "Boolean" Then Exit Sub
        If IsNumeric(hrCount) Then Exit Do
        msg = MsgBox("Please enter a whole number.", _
            vbExclamation + vbYesNo, "Try again?")
        If msg = vbNo Then Exit Sub
    Loop
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet
    On Error Resume Next
        Set dws = wb.Worksheets(wsName)
    On Error GoTo 0
    If Not dws Is Nothing Then
        msg = MsgBox("The worksheet already exists. " _
            & "Do you want to delete it?", vbExclamation + vbYesNo, "Continue?")
        If msg = vbNo Then
            Exit Sub
        Else
            Application.DisplayAlerts = False
            dws.Delete
            Application.DisplayAlerts = True
        End If
    End If
    wb.Worksheets(1).Copy Before:=wb.Sheets(1)
    Set dws = wb.Worksheets(1)
    dws.Name = wsName
    
    Dim wsCount As Long: wsCount = wb.Worksheets.Count
    If wsCount < 4 Then Exit Sub
    
    Dim dfCell As Range
    Set dfCell = dws.Cells(dws.Range("A1").CurrentRegion.Rows.Count + 1, "A")
    
    Dim srg As Range
    Dim n As Long
    
    For n = 4 To wb.Worksheets.Count Step 2
        With wb.Worksheets(n).Range("A1").CurrentRegion
            Set srg = .Resize(.Rows.Count - hrCount).Offset(hrCount)
        End With
        srg.Copy dfCell
        Set dfCell = dfCell.Offset(srg.Rows.Count)
    Next n

    MsgBox "Master worksheet created.", vbInformation
   
End Sub