PDA

View Full Version : Create Multiple Workbooks with multiple worksheets from master workbook



grungernelly
05-07-2011, 10:31 AM
Hello All!

I'm new to this but I have an issue. In a nutshell I want to copy (create) multiple workbooks and name them based on the list of filenames in Sheet1.

I am using Jerry Beaucaire's FillOutTemplate macro.(you can google this, I cannot post links yet)

The code is working i.e. it is creating the workbooks, all named well and information inputted but I cannot get the code to include extra sheets (it will only copy the one sheet). How can I manipulate the code so that I can also add multiple sheets that appear in the original 'master' workbook? n.b I do not need these extra sheets to be touched by the code that inserts the data.


Sub FillOutTemplate()
'Jerry Beaucaire 4/25/2010
'From Sheet1 data fill out template on sheet2 and save
'each sheet as its own file.
Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String

Application.ScreenUpdating = False 'speed up macro execution
Application.DisplayAlerts = False 'no alerts, default answers used

Set dSht = Sheets("Data") 'sheet with data on it starting in row2
Set tSht = Sheets("Template") 'sheet to copy and fill out 'Option to create separate workbooks

MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
"YES = template will be copied to separate workbooks." & vbLf & _
"NO = template will be copied to sheets within this same workbook", _
vbYesNo + vbQuestion) = vbYes
If MakeBooks Then 'select a folder for the new workbooks

MsgBox "Please select a destination for the new workbooks"
Do
With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then 'a folder was chosen

SavePath = .SelectedItems(1) & "\"
Exit Do
Else 'a folder was not chosen

If MsgBox("Do you wish to abort?", _
vbYesNo + vbQuestion) = vbYes Then Exit Sub
End If
End With
Loop
End If 'Determine last row of data then loop through the rows one at a time

LastRw = dSht.Range("A" & Rows.Count).End(xlUp).Row
For Rw = 2 To LastRw

tSht.Copy After:=Worksheets(Worksheets.Count) 'copy the template
With ActiveSheet

'fill out the form
'edit these rows to fill out your form, add more as needed
.Name = dSht.Range("A" & Rw)
.Range("B3").Value = dSht.Range("A" & Rw).Value
.Range("C4").Value = dSht.Range("B" & Rw).Value
.Range("D5:D7").Value = dSht.Range("C" & Rw, "E" & Rw).Value
End With

If MakeBooks Then

'if making separate workbooks from filled out form
ActiveSheet.Move
ActiveWorkbook.SaveAs SavePath & Range("B3").Value, xlNormal
ActiveWorkbook.Close False
End If

Cnt = Cnt + 1
Next Rw

dSht.Activate
If MakeBooks Then

MsgBox "Workbooks created: " & Cnt
Else

MsgBox "Worksheets created: " & Cnt
End If

Application.ScreenUpdating = True
End Sub
Can this be done?

Thanks in advance for your help. :-)

Neil

Rob342
05-25-2011, 02:50 PM
Neil
Not quite sure where you want the additional sheets put?

The code below will insert additional sheets with a yes no option

Sub Macro1()

Sheets("sheet1").Select 'Put in your own name instead of sheet1
If MsgBox("Are You Sure you want to Add another sheet! (Y/N)?", _
vbYesNo, "Add Additional sheet") = vbYes Then
Sheets.Add
End If
End Sub


Rob