JC:
I don't write the shortest code of anybody around, but I usually always get
what I want and it works!!! The following code copies the currently active
sheet, assuming that it does not already have a sequence number appended on
the end, and names it the same with an incremented number appended on the
end. If the active worksheet already appears to have a sequence number on
the end of the name, the routine displays an error message and does not
copy. As far as the number of digits in the sequence number are concerned,
it uses the same number of digits as the previous sheet. So, if the active
sheet is named "WeekA" and is the only copy so far, then the new copy will
be "WeekA1". If the largest copy so far is "WeekA001", then the next copy
of "WeekA" will be "WeekA002" and so on. The new copy is placed to the
right of the copy with the largest sequence number so far. The originally
active sheet will be re-activated at the end of the routine.
Let us know how you like it!
Option Explicit
'----------------------------------------------------------------------
Public Sub CopyAndRenameWorksheet()
'Code by Bill Renaud.
Dim wsOriginal As Worksheet
Dim wsLast As Worksheet
Dim wsNew As Worksheet
Dim strBaseName As String
Dim strSequence As String
Application.ScreenUpdating = False
Set wsOriginal = ActiveSheet
SplitString wsOriginal.Name, strBaseName, strSequence
If strSequence <> "" Then GoTo ErrCopyAndRenameWorksheet
Set wsLast = LastSequencedWorksheet(wsOriginal)
With wsOriginal
.Copy After:=wsLast
Set wsNew = Worksheets(wsLast.Index + 1) 'Set reference to new
worksheet.
End With
With wsNew
If wsLast Is wsOriginal _
Then
'This is the first sequenced worksheet to be added.
.Name = wsOriginal.Name & "1"
Else
'Copy the naming format from the previously sequenced worksheet.
SplitString wsLast.Name, strBaseName, strSequence
.Name = wsOriginal.Name & _
Format$(CLng(strSequence) + 1, _
String(Len(strSequence), "0"))
End If
End With
'Re-activate original worksheet.
wsOriginal.Activate
Exit Sub
ErrCopyAndRenameWorksheet:
MsgBox "Active worksheet is a copy" & vbNewLine & _
"of the original worksheet.", _
vbCritical + vbOKOnly, _
"Error Copying and Renaming Worksheet"
End Sub
'----------------------------------------------------------------------
'LastSequencedWorksheet locates the worksheet in the workbook that has
'the highest sequence number, based on an original worksheet. If there
'are no sequenced worksheets, then a reference to the original worksheet
'is returned.
Private Function LastSequencedWorksheet(wsOriginal As Worksheet) _
As Worksheet
Dim wb As Workbook
Dim ws As Worksheet
Dim wsLast As Worksheet
Dim lngLast As Long
Dim strBaseName As String
Dim strSequence As String
Set wb = wsOriginal.Parent
Set wsLast = Nothing
lngLast = 0
'Locate the highest sequence numbered worksheet.
For Each ws In wb.Worksheets
SplitString ws.Name, strBaseName, strSequence
If strBaseName = wsOriginal.Name And _
strSequence <> "" _
Then
If CLng(strSequence) > lngLast _
Then
'Capture and keep this highest sequenced worksheet.
Set wsLast = ws
lngLast = CLng(strSequence)
End If
End If
Next ws
If wsLast Is Nothing _
Then
Set LastSequencedWorksheet = wsOriginal
Else
Set LastSequencedWorksheet = wsLast
End If
End Function
'----------------------------------------------------------------------
'SplitString splits an expression into 2 parts. Sequence is the
'contiguous string of digits from the right end of the string.
'BaseName is the remainder of the string to the left of Sequence.
'Blank strings are returned for each part that does not exist.
'
' Expression BaseName Sequence
' ---------- -------- --------
' "" "" ""
' Sheet Sheet ""
' Sheet1A Sheet1A ""
' Sheet1 Sheet 1
' Sheet01 Sheet 01
' 123 "" 123
Public Sub SplitString(Expression As String, _
BaseName As String, _
Sequence As String)
Dim lngLastNonDigit As Long
If Expression = "" Then GoTo ErrNoString
lngLastNonDigit = Len(Expression)
While (Mid$(Expression, lngLastNonDigit, 1) Like "#")
'Character is a digit, so step left one character.
lngLastNonDigit = lngLastNonDigit - 1
If lngLastNonDigit = 0 Then GoTo Continue
Wend
Continue:
BaseName = Left$(Expression, lngLastNonDigit)
Sequence = Right$(Expression, Len(Expression) - lngLastNonDigit)
GoTo ExitSub
ErrNoString:
BaseName = ""
Sequence = ""
GoTo ExitSub
ExitSub:
End Sub
