View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
carlo carlo is offline
external usenet poster
 
Posts: 367
Default Duplicate sheets by data count

Try this sub:

Sub CreateSheets()
Dim ws_list As Worksheet
Dim ws_template As Worksheet
Dim ws_new As Worksheet
Dim uniqueColumn As Range
Dim lastRow As Integer
Dim startRow As Integer
Dim cell_ As Range

Set ws_list = Sheets("list")
Set ws_template = Sheets("template")
lastRow = ws_list.Cells(65536, 1).End(xlUp).Row
startRow = 2
Set uniqueColumn = ws_list.Range(ws_list.Cells(startRow, 1),
ws_list.Cells(lastRow, 1))

For Each cell_ In uniqueColumn
If Not WksExists(cell_.Value) Then
ws_template.Copy After:=Sheets(Sheets.Count)
Set ws_new = ActiveSheet
ws_new.Name = cell_ '
ws_new.Range("A1") = cell_
End If
Next cell_

End Sub


Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function


hth

Carlo

On Jan 10, 12:38*pm, gh0st wrote:
I have one sheet named "contacts" that lists approx 100 people in
"column A". *I

have another sheet that is used as a template, which I need to
duplicate by the

number of people in the contacts column. The sheets need to be number
2 - 100

and the name of each contact is to be placed in their corresponding
sheet at A1. As

well as placing the contact name in the sheet, this name should be
hyper linked

back to the contacts sheet.
I started trying to merge these two Subs to achieve this but I think I
am missing

something.

Sub Duplicate_Sheet()
Dim i As Integer
Application.ScreenUpdating = False
* For i = 1 To 100
* * Sheets("template").Copy after:=Sheets(Sheets.Count)
* * Sheets("template (2)").Name = i
Next
Application.ScreenUpdating = True
End Sub

Sub Addsheets()
Dim rng as Range
Cell as Range
with worksheets("contacts")
*set rng = .Range("A2",.Range("A2").End(xldown))
End with

for each cell in rng
* worksheets.Add After:=Worksheets(worksheets.count)
* activesheet.name = Cell.value
Next
end sub

Many Thanks in Advance
gh0st