PDA

View Full Version : Copy Template to sheets



Odyrus
07-06-2012, 08:00 AM
Good day,

I use the following code to create worksheets from a list on my interface worksheet.

What I'd like to do is incorporate copying a template slide to these worksheets after they've been created.

Any thoughts on how to best accomplish this are much appreciated!


Sub CreateSheetsFromAList()
Dim MyCell As Range, MyRange As Range

Set MyRange = Sheets("interface").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Value
Next MyCell
End Sub

CatDaddy
07-06-2012, 08:04 AM
For Each MyCell In MyRange
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = MyCell.Text
Sheets("interface").Range(somerange).Copy Destination:=Sheets(MyCell.Text).Range("A1")
Next MyCell

snb
07-06-2012, 08:13 AM
What is a template slide ?

sub snb()
For Each cl In Sheets("Blad1").Columns(1).SpecialCells(2)
If cl.Row > 1 Then sheets.Add.Name = cl.Value
Next
end sub

Odyrus
07-06-2012, 08:22 AM
My template slide is a formatted hidden worksheet. I copy this to every new worksheet added from the macro above.

The range of cells the macro uses to add worksheets are days of the month (07_01, 07_02, etc). So, on a monthly basis it's easy to create a new monthly report. (There are several roll up sheets all tied to the date range the macro uses to create the sheets; I love the indirect function)

Anyway, I'm trying to incorporate un-hiding the template slide and copying it to the added worksheets to make the macro a little more efficient.

CatDaddy, what is "somerange" referring to here:
Sheets("interface").Range(somerange).Copy Destination:=Sheets(MyCell.Text).Range("A1")

CatDaddy
07-06-2012, 08:38 AM
whatever the range is on the template sheet that you are trying to copy over

snb
07-06-2012, 09:00 AM
I think the hidden sheet is available for every sheet in the workbook.
So why copy it ?

I think you'd better copy than add...


Sub snb()

For Each cl In Sheets("Blad1").Columns(1).SpecialCells(2)


If cl.Row > 1 Then
sheets("slide").copy ,sheets(sheets.count)

sheets(sheets.count).Name = cl.Value
end if
Next
End Sub