Copy and rename sheet in sequential order

[av8tordude]

I would like to copy, rename, and delete worksheets as follows...

My workbook will have 3 permanent sheets (Security, Master, f2106). I have a userform with 1-combo box (cboYear) and 1-Command button (cmdEnter).

Not counting the 3-permenant sheets (Security, Master, f2106)...

If no additional sheets exist (except Security, Master, & f2106), copy & rename the Master sheet with the current year (i.e. 2011).
If 1 sheet exist (i.e. 2011) + Security, Master, & f2106, copy & rename the Master sheet as 2012.
If 2 sheet exist (i.e. 2011, 2012) + Security, Master, & f2106, copy & rename the Master sheet as 2013.
If 3 sheet exist (i.e. 2011, 2012, 2013) + Security, Master, & f2106, copy & rename the Master sheet as 2014, but delete the oldest worksheet (i.e. 2011).

I have this code that copies and rename the Master sheet. Can someone assist with editing the code to accomplish the above. thanks

Note: Sheets ( Security, Master, & f2106) should NOT be deleted.


Dim MySheetName As String
If cboYear = "New Log" Then
ThisWorkbook.Unprotect Password:="MyPassword"
MySheetName = Year(Date)
Sheets("New Log").Copy before:=Sheets("f2106")
With ActiveSheet
.Unprotect Password:="MyPassword"
.Name = MySheetName
Range("B7") = "1/1/" & Year(Date)
.Protect Password:="MyPassword"
End With
ThisWorkbook.Protect Password:="MyPassword"
Me.Hide
Else
Sheets(cboYear.Value).Select
cmdEnter.Caption = "Enter"
Me.Hide
End If

[GTO]

Hi there,

I did not replicate the userform, but I think that you'll be able to easily adapt this.

Option Explicit

Sub exa()
Dim MySheetName As String
Dim wks As Worksheet
Dim COL As Collection
Dim i As Long
Dim bolAdded As Boolean

Set COL = New Collection

For Each wks In ThisWorkbook.Worksheets
If wks.Name Like "20##" Then
For i = 1 To COL.Count
If wks.Name < COL.Item(i) Then
COL.Add wks.Name, CStr(wks.Name), i
bolAdded = True
Exit For
End If
Next

If Not bolAdded Then
COL.Add wks.Name, CStr(wks.Name)
Else
bolAdded = False
End If
End If
Next

ThisWorkbook.Unprotect "MyPassword"

ThisWorkbook.Worksheets("Master").Copy Before:=ThisWorkbook.Worksheets("f2106")
Set wks = ActiveSheet
With wks
.Protect "MyPassword", , , , True
If COL.Count = 0 Then
.Name = 2011
Else
.Name = CLng(COL.Item(COL.Count)) + 1
End If
.Range("B7").Value = Date
.Range("B7").NumberFormat = "m/d/yyyy"
If COL.Count >= 3 Then
Application.DisplayAlerts = False
'// Change Col.Count - # to suit //
For i = 1 To COL.Count - 3
ThisWorkbook.Worksheets(COL.Item(i)).Delete
Next
End If
End With
ThisWorkbook.Protect "MyPassword"
End Sub
Hope that helps,

Mark

[av8tordude]

EXCELLENT!!! Thank you GTO. :friends::beerchug:

[GTO]

YIKES! Just in case you haven't already caught my blunder, DisplayAlerts needs turned back on:

If COL.Count >= 3 Then
Application.DisplayAlerts = False
'// Change Col.Count - # to suit //
For i = 1 To COL.Count - 3
ThisWorkbook.Worksheets(COL.Item(i)).Delete
Next
Application.DisplayAlerts = True
End If
Sorry about that and of course you are most welcome :-)

[av8tordude]

Thx GTO, I did notice it and I fix it. Thx for the heads up. Cheers :-)