Delete Sheets to the left

[ian bartlett]

Hi All

I add sheets through code, and when I have printed what I want I want to
delete all sheets except the two on the left in this case Sheet1(Sheet2) and
Sheet5(Sheet1) doing it with the recorder I got the following, but this will
not work after rebuilding the sheets.

Any ideas ??

Thanks Bart


Sheets("D3").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("D3", "5", "ATC", "CRU", "AA", "8", "DVJ", "DVH", "1",
"DVG", "ISA", "3", "2", _
"ISC", "7", "ISD", "D4", "9", "D2", "DVF", "4", "ISE", "ISB", "6",
"DVK")).Select
Sheets("D3").Activate
Sheets(Array("10", "12", "3M", "ADM", "180", "PX3", "HOME",
"UAL")).Select Replace:= _
False
Sheets(Array("D3", "5", "ATC", "CRU", "AA", "8", "DVJ", "DVH", "1",
"DVG", "ISA", "3", "2", _
"ISC", "7", "ISD", "D4", "9", "D2", "DVF", "4", "ISE", "ISB", "6",
"UAL")).Select
Sheets("UAL").Activate
Sheets(Array("DVK", "10", "12", "3M", "ADM", "180", "PX3",
"HOME")).Select Replace:= _
False
ActiveWindow.SelectedSheets.Delete
Range("F6").Select

 

[Per Jessen]

Hi

Look at this:

Sub DeleteSheeets()
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Sheet1" And sh.Name <> "Sheet2" Then
sh.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

Regards,
Per

 

[Don Guillett]

This should delete sheets to the right of the active sheet.

Sub delshtsbyindex()
sc = Sheets.Count
'MsgBox sc
ms = ActiveSheet.Index
'MsgBox ms
For i = ms To sc
Sheets(i).Delete
'MsgBox Sheets(i).Name
Next i
End Sub

 

[Chip Pearson]

For i = ms To sc

Sheets(i).Delete
Next i

Did you test that code? It doesn't work because 'i' will go past Sheet.Count
midway through the loop.


--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[ian bartlett]

Don

Chip is right it seems when I run your code I get the error
Run time error 9
Subscript out of range.

Any other ideas ??

 

[Chip Pearson]

Try code like the following.

Sub AAA()
On Error GoTo ErrH:
Application.DisplayAlerts = False
With ThisWorkbook.Worksheets
Do Until .Count <= 2
.Item(.Count).Delete
Loop
End With
ErrH:
Application.DisplayAlerts = True
End Sub



--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[Rick Rothstein]

Give this a try (I'd put it in a Module)...

Sub DeleteWorksheets()
Dim WS As Worksheet
Worksheets(1).Select
On Error GoTo Whoops
Application.DisplayAlerts = False
For Each WS In Worksheets
If WS.Index > 2 Then WS.Delete
Next
Whoops:
Application.DisplayAlerts = True
End Sub

 

[john]

another way maybe

Sub DeleteSheets()
Dim Arr() As String
'Create an Array
'of all Sheets
Dim N As Long
Application.DisplayAlerts = False
With ThisWorkbook
With .Worksheets
If .Count < 3 Then Exit Sub
ReDim Arr(3 To .Count)
For N = 3 To .Count
Arr(N) = .Item(N).Name
Next N
End With
.Worksheets(Arr).Delete
End With
Application.DisplayAlerts = True
End Sub

 

[ian bartlett]

Chip, Rick & John

Thanks very much I tried all three and all performed as stated

Thanks again.

Bart

 

[Don Guillett]

Since I didn't really want to delete sheets I only tested with
sheets(i).select
MY BAAD!