I would like a macro to copy the current sheet with appending 01, 02 etc
after it and so on.

Example:

If the current Worksheet was called "WeekA" if I ran the macro 4 times I
would result the following worksheets.

WeekA (current)
WeekA01
WeekA02
WeekA03
WeekA04

If I then exited the Document and opened it again and ran the macro on
"WeekA" worksheet again it would create "WeekA05"

Not a VBA man - only got this far:-

Sub CopyRen()
Dim shtName As String
shtName = ActiveSheet.Name
ActiveSheet.Copy after:=ActiveSheet
ActiveSheet.Name = shtName & "01"
Sheets(shtName).Activate
End Sub


Thanks
John

Sub CopyRen()
Dim shtName As String
Dim intLast As Integer
intLast = ActiveWorkbook.Sheets.Count
shtName = Sheets(1).Name
ActiveSheet.Copy after:=Sheets(intLast)
ActiveSheet.Name = shtName & Format(intLast, "00")
Sheets(shtName).Activate
End Sub

That should do it


"JC" wrote:

> I would like a macro to copy the current sheet with appending 01, 02 etc
> after it and so on.
>
> Example:
>
> If the current Worksheet was called "WeekA" if I ran the macro 4 times I
> would result the following worksheets.
>
> WeekA (current)
> WeekA01
> WeekA02
> WeekA03
> WeekA04
>
> If I then exited the Document and opened it again and ran the macro on
> "WeekA" worksheet again it would create "WeekA05"
>
> Not a VBA man - only got this far:-
>
> Sub CopyRen()
> Dim shtName As String
> shtName = ActiveSheet.Name
> ActiveSheet.Copy after:=ActiveSheet
> ActiveSheet.Name = shtName & "01"
> Sheets(shtName).Activate
> End Sub
>
>
> Thanks
> John
>
>
>

Thanks for the reply but the code you have done works only if you have 1
worksheet in your document.

The document I need this for has a number of worksheets eg.

shtTotals
shtTime
WeekA
WeekB
WeekC
etc

When I run the macro I need it to use the name of the current worksheet
which say is "WeekA"

Running your code with "WeekA" as current produces a worksheet at the end
called "shtTotals04" (shown below)
shtTotals
shtTime
WeekA
WeekB
WeekC
shtTotals05

I need it to produce a worksheet(s) "WeekA01" "WeekA02" etc just after the
current worksheet
shtTotals
shtTime
WeekA
WeekA01
WeekA02
WeekB
WeekC

or

shtTotals
shtTime
WeekA
WeekA02
WeekA01
WeekB
WeekC

if that's easier to do



Thanks again
John




"Smallweed" <(E-Mail Removed)> wrote in message
news:42038FDA-79E5-45F0-9E09-(E-Mail Removed)...
> Sub CopyRen()
> Dim shtName As String
> Dim intLast As Integer
> intLast = ActiveWorkbook.Sheets.Count
> shtName = Sheets(1).Name
> ActiveSheet.Copy after:=Sheets(intLast)
> ActiveSheet.Name = shtName & Format(intLast, "00")
> Sheets(shtName).Activate
> End Sub
>
> That should do it
>
>
> "JC" wrote:
>
>> I would like a macro to copy the current sheet with appending 01, 02 etc
>> after it and so on.
>>
>> Example:
>>
>> If the current Worksheet was called "WeekA" if I ran the macro 4 times I
>> would result the following worksheets.
>>
>> WeekA (current)
>> WeekA01
>> WeekA02
>> WeekA03
>> WeekA04
>>
>> If I then exited the Document and opened it again and ran the macro on
>> "WeekA" worksheet again it would create "WeekA05"
>>
>> Not a VBA man - only got this far:-
>>
>> Sub CopyRen()
>> Dim shtName As String
>> shtName = ActiveSheet.Name
>> ActiveSheet.Copy after:=ActiveSheet
>> ActiveSheet.Name = shtName & "01"
>> Sheets(shtName).Activate
>> End Sub
>>
>>
>> Thanks
>> John
>>
>>
>>

You might also try searching the newsgroup archives using Google:
http://groups.google.com/group/micro...ramming/topics
Enter the search term "copy rename worksheet".

I found a post titled "Button to copy sheet, rename sheet sequencially."
[sic]:
http://groups.google.com/group/micro...db28d421e8237b
Scroll to the bottom to see a reply posted by Dave Peterson on Jun 17 2005
7:41 am that is pretty close to what you need to get started.

--
Regards,
Bill Renaud

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

--
Regards,
Bill Renaud