COPYING Workbook and sheets automatically

[control freak]

Hello, this is what i need to accomplish:

I have a workbook with a sheet named "template" and another sheet where
user can enter names in column A.

When button is pressed after all names entered, i want the button to
create a new workbook complete with multiple (however many names
entered in column A) copies of the template sheet named after contents
of column A in original workbook. as well as name the new workbook
from the contents of a cell in original workbook.

I have gotten as far as creating new workbook with only 1 copy, hangs
after first copy, my guess is that its focus is now on new workbook and
cannot complete the macro.

my code so far (with appreciated help from forum) is:

Private Sub CommandButton1_Click()
With Worksheets("START")
For Each cell In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
If Not IsEmpty(cell) Then
Worksheets("template").Copy
ActiveSheet.Name = cell.Value
End If
Next
End With
End Sub

I hope someone has some insight if this can be done??

Thanks again

Troy

 

[Guest]

Pls try this one:

Private Sub CommandButton1_Click()
With Worksheets("START")
For Each cell In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
If Not IsEmpty(cell) Then
Worksheets("template").Copy
ActiveSheet.Name = cell.Value
.Activate
End If
Next
End With
End Sub

 

[control freak]

Thank you for your reply, this code will create multiple workbooks, I
need it to create only 1 workbook with multiple copys of the sheet
"template" based on the names listed in column a.

So if i have 3 names( ted, bruce, art) listed in column A, i need to
create 1 new workbook with 3 sheets in it named (ted, bruce, and art)
that are copies of the original sheet "template".

and if possible name the new workbook based on a cell on original
workbook (say column b for example).

I appreciate all the help from these forums as I am not familiar with
VBA coding.

Troy

 

[Guest]

Hi
Pls try this one:
Private Sub CommandButton1_Click()
Dim wbkS As Workbook
Dim wbkD As Workbook
Dim i As Integer

Application.DisplayAlerts = False

Set wbkS = ThisWorkbook
Set wbkD = Workbooks.Add


With wbkS.Sheets("START")
For Each cell In .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
If Not IsEmpty(cell) Then
wbkS.Worksheets("template").Copy after:=wbkD.Sheets(wbkD.Sheets.Count)
wbkD.Activate
ActiveSheet.Name = cell.Value
.Activate
End If
Next
End With
wbkD.Activate
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True
End Sub

 

[control freak]

Excellent !, thank you very much for your help, it is greatly
appreciated. ;-)