Create Worksheet From Values in Existing Cells Using Existing Worksheet as Template.

[Ardy]

Hello All:
I have been trying to do the following and haven't been successful. I
have a workbook(Excel file) that has two worksheet one is called Roster
and the other is called template(a pre-formated worksheet). In the
Roster I have the names of the students. In one Colum A starting from
cell A2. I have created a button that will hopefully do the following.
1) Reads the values in Colum A (starting from A2). 2) Create
worksheets using Template worksheet and naming it the values stored in
previous step. Please know that I am not a programmer but do my best to
peace mill What I find. I have found,

Private Sub CommandButton1_Click()
Dim LastCell As Range, Rng As Range, cell As Range
Dim WS As Worksheet
Set WS = ActiveSheet
Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
Set Rng = WS.Range("A2", LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Sheets.Add.Name = cell.Value

End If
Next
End Sub

This makes the worksheets with the name of the values, but I can't
quite get it to use the template for copying. Any help on this is
greatly appreciated.

Ardy

 

[Nigel]

after the line

Sheets.Add.Name = cell.Value

add this

Sheets("template").Cells.Copy Destination:=Sheets(cell.Value).Range("A1")

 

[Ardy]

Thanks.
I have changed the code as you have suggested to:

Private Sub CommandButton1_Click()
Dim LastCell As Range, Rng As Range, cell As Range
Dim WS As Worksheet
Set WS = ActiveSheet
Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
Set Rng = WS.Range("A2", LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Sheets.Add.Name = cell.Value
Sheets("Template").Cells.Copy
Destination:=Sheets(cell.Value).Range("A1")
End If
Next
End Sub

I get an -->Run-Time error"9"
Subscript out of range.

I am trying diffrent variations of code but so far am not successfull.
Should A1 be A2

Ardy

 

[Nigel]

hi Ardy
Is the name of your template sheet called Template, the name on the Tab ?

 

[Bob Phillips]

Private Sub CommandButton1_Click()
Dim LastCell As Range, Rng As Range, cell As Range
Dim WS As Worksheet

Set WS = ActiveSheet
Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
Set Rng = WS.Range("A2", LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
End If
Next
End Sub



--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Ardy]

Yes

hi Ardy
Is the name of your template sheet called Template, the name on the Tab ?

 

[Ardy]

First of all I want to thank you both for helping me on this. My wife
who is a K9 teacher is also very appreciative of this.

Bob, Nigel
I have created a second Command button to preserve my first code. I
get the same error on Bob's version of the code. When it says out of
range dose this mean range (Colum A is grater than it can handle) I
only have 3 names for the sake of testing. It potentially could go to
40. Not to over extend my welcome I also am trying to link the
names(in the Roster Tab) to their respected tabs (worksheets)either
after or during the creation. This is for the Teachers to easily
navigate to each student tab. I have already have code in each tab to
navigate back to the Roster.

--------------Latest Code ---------------------------------
Private Sub CommandButton2_Click()
Dim LastCell As Range, Rng As Range, cell As Range
Dim WS As Worksheet

Set WS = ActiveSheet
Set LastCell = WS.Cells(Rows.Count, "A").End(xlUp)
Set Rng = WS.Range("A2", LastCell)
For Each cell In Rng
If Not IsEmpty(cell) Then
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = cell.Value
End If
Next
End Sub
---------------------------------------------------------------------

 

[Bob Phillips]

I tested it and it worked okay for me.

Where do you get the error?

We'll get the create to work first, then worry about the navigating.

BTW, what is a K9 teacher?

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Ardy]

I get the error in line:
Sheets("Template").Copy after:=Worksheets(Worksheets.Count)

I have some images that might help you see what I see. At
http://www.pesare-darya.com/error.htm
Eventually when I get it working all names will be under column A. K9
is the term used for teachers that are certified by state to teach in
public schools grade Kinder to 9th grade, basically your elementary
school all the way to end of middle school. My wife is a 1st grade
teacher. It sound like dog trainer K9 some time I bug her abt
that.....LOL.

Ardy

 

[Nigel]

This continues to be the problem, the only subscript is the sheet
"Template", you have confirmed that it exists and has this name. My earlier
code works OK in my environment and Bob's code uses the copy sheet after
method relies on the sheet both existing and being named Template.

You had said it worked at one stage, I recall. Can you check after the
error has arisen that the sheet Template is still there? Also one other
thought change the test for an empty cell in the range (with names) If
Not IsEmpty(cell) Then to this

If Len(Trim(cell)) > 0 then

 

[Ardy]

Oh for god sake you look at a code enough time you think you see things
that don't exist. Guys my mistake the Template was actually Templat.
It works perfect. Is there a lot of hassle linking (Adding link) to
the names in the roster to their respected tabs(Worksheet)

Ardy

 

[Bob Phillips]

This should create hyperlinks on the list

Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim sh As Worksheet
Dim cell As Range

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
.Hyperlinks.Add Anchor:=Cells(i, "A"), _
Address:="", _
SubAddress:=Cells(i, "A").Value & "!A1", _
TextToDisplay:=Cells(i, "A").Value
Next i

End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Ardy]

Bob:
Dose this needs to be run as a second button or as a module which will
be called from code that created the tabs (Worksheet).

Ardy

 

[Bob Phillips]

No just run it once directly from the VBIDE.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Ardy]

I changed so it will start from cell A2 allowing for header in A1, ran
it from VBIDE it skips the A1 which is good, makes the link in A2.
Clicking the link will result in Reference is not valid. I think it
should link it to the tab with the same student.

------------------------------------Latest
Code-----------------------------------
Public Sub ProcessData()
Dim iLastRow As Long
Dim i As Long
Dim sh As Worksheet
Dim cell As Range

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 2 Step -2
Sheets("Roster").Hyperlinks.Add Anchor:=Cells(i,
"A"), _
Address:="", _
SubAddress:=Cells(i, "A").Value & "!A1", _
TextToDisplay:=Cells(i, "A").Value
Next i

End With

End Sub

 

[Bob Phillips]

Indeed it should. Can you send me your worksheet, I can't debug from afar.

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Ardy]

I emailed you the file, I don't know How to thank you for
this.........I really appreciate your effort.

 

[Bob Phillips]

I have responded. This is what I wrote

My mistake Ardy, I didn't cater for spaces in the name. Try this

Private Sub CommandButton2_Click()
' Public Sub ProcessData()
' for testing
Dim iLastRow As Long
Dim i As Long
Dim sh As Worksheet
Dim cell As Range

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
.Hyperlinks.Add Anchor:=Cells(i, "A"), _
Address:="", _
SubAddress:="'" & Cells(i, "A").Value & "'!A1",
_
TextToDisplay:=Cells(i, "A").Value
Next i

End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Ardy]

It works like a charm...........
Thanks......

I have responded. This is what I wrote

My mistake Ardy, I didn't cater for spaces in the name. Try this

Private Sub CommandButton2_Click()
' Public Sub ProcessData()
' for testing
Dim iLastRow As Long
Dim i As Long
Dim sh As Worksheet
Dim cell As Range

With ActiveSheet

iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = iLastRow To 1 Step -1
.Hyperlinks.Add Anchor:=Cells(i, "A"), _
Address:="", _
SubAddress:="'" & Cells(i, "A").Value & "'!A1",
_
TextToDisplay:=Cells(i, "A").Value
Next i

End With

End Sub

--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)