Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy & rename a sheet appending 01,02,03 ..etc
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy & rename a sheet appending 01,02,03 ..etc
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy & rename a sheet appending 01,02,03 ..etc
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" wrote in message ... 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy & rename a sheet appending 01,02,03 ..etc
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy & rename a sheet appending 01,02,03 ..etc
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to copy a sheet and rename it with the value of two cells from the source sheet? | Excel Programming | |||
Copy/Rename a sheet | Links and Linking in Excel | |||
Button to copy sheet, rename sheet sequencially. | Excel Programming | |||
Copy a sheet and rename it | Excel Programming | |||
copy Sheet and rename it! | Excel Programming |