Check for two sheets. Add or subtract as necessary.

  • Thread starter Thread starter Colin Hayes
  • Start date Start date
C

Colin Hayes

HI

I'm hoping someone can help with a short routine.

I need to check that there are 2 worksheets present in the workbook.

If there is only one , then a second has to be added to the end.

So tabs :

Sheet1

Becomes

Sheet1 Sheet2


If there are more than 2 then the additional ones should be deleted form
the end.

So tabs:

Sheet1 Sheet2 Sheet3 ...

Becomes

Sheet1 Sheet2



Grateful for your help.



Best Wishes
 
Hi Colin,

Am Wed, 18 Jun 2014 14:57:38 +0100 schrieb Colin Hayes:
Sheet1

Becomes

Sheet1 Sheet2
Click to expand...
Sheet1 Sheet2 Sheet3 ...

Becomes

Sheet1 Sheet2
Click to expand...

try:

Sub SheetCheck()
Dim i As Long

Select Case Sheets.Count
Case 1
Sheets.Add after:=Sheets(Sheets.Count)
Case Is > 2
For i = Sheets.Count To 3 Step -1
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
Next
End Select
End Sub


Regards
Claus B.
 
Sub SheetCheck()
Dim i As Long

Select Case Sheets.Count
Case 1
Sheets.Add after:=Sheets(Sheets.Count)
Case Is > 2
For i = Sheets.Count To 3 Step -1
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
Next
End Select
End Sub


Regards
Claus B.
Click to expand...

Hi Claus

OK thanks for this. Perfect first time.


Best Wishes ,

Colin
 
Back
Top