View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tom Ogilvy Tom Ogilvy is offline
external usenet poster
 
Posts: 27,285
Default Help!! copy worksheet and assign a name to new worksheet.

Dim sh as Worksheet'
Dim maxNum as Long, num as Long
for each sh in activeworkbook.worksheets
maxNum = 18
if sh.Name Like "TG*" then
num = clng(Right(sh.Name,len(sh.Name)-2))
if num MaxNum then
MaxNum = Num
end if
end if
Next
worksheets("TG18").copy After:=worksheets(worksheets.count)
Activesheet.Name = "TG" & num + 1

--
Regards,
Tom Ogilvy


"Steven" wrote in message
oups.com...
Hi, All.

I am trying to write a macro that copies/duplicates a worksheet named
"TG18" in the workbook, and assign new name as "TG19" and "TG20",
"TG21", "TG22" and so on ......
In this group, I have found some macro that does duplicates last
worksheet in the workbook, but it requires the name of worksheet must
be only in number format...
And I feel somehow this code is very complicated..
Any help would be appreciated. Thank you for taking your time.

The code I am using now ( which supports worksheet name as only number)

Option Explicit


Private Sub CopyLastSheet()

Dim LastN As Long
Dim N As Long
Dim S As Long
Dim SheetCount As Long


'1st task is to find the last sheet, the one
'with the highest name/number
SheetCount = ThisWorkbook.Worksheets.Count
LastN = 0
For S = 1 To SheetCount
N = CLng(Worksheets(S).Name)
If N LastN Then LastN = N
Next S


'the next line copies the sheet with the highest number
'if the macro has been run at least once before, that sheet is
itself
'a copy and has no formulas
'are you sure this is the sheet you want to copy?
Worksheets(CStr(LastN)).Copy After:=Worksheets(SheetCount)


'are you sure you don't want something like this instead of the
above???
'Worksheets("Master").Copy After:=Worksheets(SheetCount)


SheetCount = SheetCount + 1
With Worksheets(SheetCount)
LastN = LastN + 1
.Name = Format$(LastN)
With .Range("A1:H67")
.Copy
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
End With
Application.CutCopyMode = False
End Sub