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

user_19100004 0
Viewed 63

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!

worksheet-function vba excel
3 Answers

Usually when we delete items from a collection we iterate backwards to avoid the items shifting from their original positions. Here, I create an array with all the names of the odd worksheets and use it to delete them in one operation.

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
user_99127140

If you just want to delete worksheets 1,3,5,...

Dim i As Long
Dim LastWk As Integer
'delete odds worksheets

'first we must check if last worksheet is odd or even
LastWk = Worksheets.Count
LastWk = IIf(Application.WorksheetFunction.IsOdd(LastWk), LastWk, LastWk - 1)

For i = LastWk To 1 Step -2
    Application.DisplayAlerts = False
    Worksheets(i).Delete
    Application.DisplayAlerts = True
Next i

You just need a loop but using the optional parameter Step(Amount counter is changed each time through the loop. If not specified, step defaults to one.)

We iterate backwards so index do not change when deleting worksheets

For...Next statement

user_91998280

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
user_98140690
Related