macro/new sheets

D

daolb

my excisting workbook exists out of 4 sheets, one general sheet, and 3
detail information sheets. I want the possibility to create in one
actions duplicates of those 3 sheets, so i get 7 sheets. I may redo
that several times.

I though about macro's to do that. I also want that the name of the
sheet is created automatically, this by adding by the sequence number
+1.

for example

global
use_scrn001
fun_scrn001
stat_scrn001

ACTION COPY

global
use_scrn001
use_scrn002
fun_scrn001
fun_scrn002
stat_scrn001
stat_scrn002
 
B

Bob Phillips

Dim sh As Worksheet
Dim i As Long
Dim nIndex As Long

stemp = Array("use_scrn", "fun_scrn", "stat_scrn")
For i = 0 To 2
Do
Set sh = Nothing
On Error Resume Next
nIndex = nIndex + 1
Set sh = Worksheets(stemp(i) & Format(nIndex, "000"))
On Error GoTo 0
Loop Until sh Is Nothing
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = _
stemp(i) & Format(nIndex, "000")
Next i
 
D

daolb

bob,

I'm not a VB specialist. I have pasted your code via tools/macro/visual
basic editor/insert/module

when I press F5 I get a compiler error. the word use_scrn is marked.
Maybe I do something wrong.

thanks in advance

david
 
B

Bob Phillips

David,

It needs to be within a sub. Did you do that?

Actually, there is a logic flaw in the code. This version is better

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

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.Add(after:=Worksheets(Worksheets.Count)).Name = _
sTemp(i) & Format(nIndex, "000")
End If
End If
Next i
Next sh

End Sub
 
D

daolb

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.
 
B

Bob Phillips

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
 
Top