PDA

View Full Version : Solved: copy and rename sheet in sequential order



av8tordude
03-30-2011, 08:11 PM
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
03-31-2011, 08:52 AM
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
03-31-2011, 06:15 PM
EXCELLENT!!! Thank you GTO. :friends::beerchug:

GTO
04-01-2011, 05:10 AM
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
04-01-2011, 06:08 AM
Thx GTO, I did notice it and I fix it. Thx for the heads up. Cheers :-)