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!
CodePudding user response:
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
CodePudding user response:
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
CodePudding user response:
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