• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 321
  • Last Modified:

adding template

I have a VBS script attached which creates a workbook with named worksheets based on an excel file called 'Names".  I want a template inserted into each worksheet the script creates.  Please see attached files.
Set objShell = CreateObject("WScript.Shell")

strNames = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\Names.xlsx"
strStudents = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\My Documents\Student Spelling.xlsx"
Set objExcel = CreateObject("Excel.Application")
Const xlUp = -4162
Set objNames = objExcel.Workbooks.Open(strNames, False, False)
objExcel.Visible = True
Set objStudents = objExcel.Workbooks.Add
While objStudents.Sheets.Count > 1
	objExcel.DisplayAlerts = False
	objStudents.Sheets(objStudents.Sheets.Count).Delete
	objExcel.DisplayAlerts = True
Wend
For intRow = 2 To objNames.Sheets(1).Cells(65536, "B").End(xlUp).Row
	strName = objNames.Sheets(1).Cells(intRow, "B").Value
	If objStudents.Sheets(1).Name = "Sheet1" Then
		objStudents.Sheets(1).Name = strName
	Else
		objStudents.Sheets.Add , objStudents.Sheets(objStudents.Sheets.Count)
		objStudents.Sheets(objStudents.Sheets.Count).Name = strName
	End If
Next
objNames.Close
objStudents.SaveAs strStudents
objStudents.Close
objExcel.Quit

Open in new window

WOW-example.xls
0
Dier02
Asked:
Dier02
  • 4
  • 2
1 Solution
 
dlmilleCommented:
I think you want to put the WOW-example.xls Sheet1 into each Sheet created for every student.  If that's the case, then you need to add a variable for the template, open the template, then do a copy from the template into the Student worksheet, as each sheet is created.

See the modified code, below:

I've also attached 3 files.  One for names that I made up, one for the template, and one for the output student sheet

Set objShell = CreateObject("WScript.Shell")

strNames = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\Names.xlsx"
strStudents = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\My Documents\Student Spelling.xlsx"
strTemplate = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\WOW-example.xls"
Set objExcel = CreateObject("Excel.Application")
Const xlUp = -4162
Const xlPasteAll = -4104
Set objNames = objExcel.Workbooks.Open(strNames, False, False)
Set objTemplate = objExcel.Workbooks.Open(strTemplate, False, False)
objExcel.Visible = True
Set objStudents = objExcel.Workbooks.Add
While objStudents.Sheets.Count > 1
      objExcel.DisplayAlerts = False
      objStudents.Sheets(objStudents.Sheets.Count).Delete
      objExcel.DisplayAlerts = True
Wend
For intRow = 2 To objNames.Sheets(1).Cells(65536, "B").End(xlUp).Row
      strName = objNames.Sheets(1).Cells(intRow, "B").Value
      If objStudents.Sheets(1).Name = "Sheet1" Then
            objStudents.Sheets(1).Name = strName
      Else
            objStudents.Sheets.Add , objStudents.Sheets(objStudents.Sheets.Count)
            objStudents.Sheets(objStudents.Sheets.Count).Name = strName
      End If
     objTemplate.Sheets(1).Cells.Copy
      objStudents.Sheets(strName).Cells.PasteSpecial(xlPasteAll)

Next
objNames.Close
objStudents.SaveAs strStudents
objStudents.Close
objExcel.Quit

Set objShell = CreateObject("WScript.Shell")

strNames = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\Names.xlsx"
strStudents = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\My Documents\Student Spelling.xlsx"
strTemplate = objShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\WOW-example.xls"
Set objExcel = CreateObject("Excel.Application")
Const xlUp = -4162
Const xlPasteAll = -4104
Set objNames = objExcel.Workbooks.Open(strNames, False, False)
Set objTemplate = objExcel.Workbooks.Open(strTemplate, False, False)
objExcel.Visible = True
Set objStudents = objExcel.Workbooks.Add
While objStudents.Sheets.Count > 1
	objExcel.DisplayAlerts = False
	objStudents.Sheets(objStudents.Sheets.Count).Delete
	objExcel.DisplayAlerts = True
Wend
For intRow = 2 To objNames.Sheets(1).Cells(65536, "B").End(xlUp).Row
	strName = objNames.Sheets(1).Cells(intRow, "B").Value
	If objStudents.Sheets(1).Name = "Sheet1" Then
		objStudents.Sheets(1).Name = strName
	Else
		objStudents.Sheets.Add , objStudents.Sheets(objStudents.Sheets.Count)
		objStudents.Sheets(objStudents.Sheets.Count).Name = strName
	End If
	objTemplate.Sheets(1).Cells.Copy
	objStudents.Sheets(strName).Cells.PasteSpecial(xlPasteAll)
Next
objNames.Close
objStudents.SaveAs strStudents
objStudents.Close
objExcel.Quit

Open in new window

Names.xlsx WOW-example.xls Student-Spelling.xlsx
0
 
Dier02Author Commented:
If I put those three files in a folder would it still work?
0
 
Dier02Author Commented:
The folder is called WOW Project
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
Dier02Author Commented:
on the desktop of "x" user.
0
 
Dier02Author Commented:
Worked beautifully.  Thank you.
0
 
dlmilleCommented:
Just set the directory correctly in the vsb file and you can put the files whereever you think makes sense.

Dave
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now