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
|