Try this then

Sub NewSheet()
Dim sh As Worksheet
Dim sh2 As Worksheet
Dim i As Long
Dim nIndex As Long
Dim sTemp

sTemp = Array("use_scrn", "fun_scrn", "stat_scrn")
For Each sh In ActiveWorkbook.Worksheets
For i = 0 To 2
If Left(sh.Name, Len(sTemp(i))) = sTemp(i) Then
nIndex = Right(sh.Name, _
Len(sh.Name) - Len(sTemp(i))) + 1
Set sh2 = Nothing
On Error Resume Next
Set sh2 = Worksheets(sTemp(i) & Format(nIndex, "000"))
On Error GoTo 0
If sh2 Is Nothing Then
Worksheets(sTemp(i) & "001").Copy
after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = sTemp(i) & Format(nIndex, "000")
End If
End If
Next i
Next sh

End Sub


--
HTH

Bob Phillips

"daolb" wrote in
message ...

bob,

when I excute the macro, excel creates 3 new sheets, but they are
empty. I want to copy also the content, like formules, lay-out,
validation, protection and even VB code.


--
daolb
------------------------------------------------------------------------
daolb's Profile:
http://www.excelforum.com/member.php...o&userid=24478
View this thread: http://www.excelforum.com/showthread...hreadid=381921