Creating multisheet workbook from multiple templates, vba

shanzek

New Member
Joined
Feb 23, 2004
Messages
19
I have a worksheet with a list of employees and job codes. I also have a template for the first half of a review that is common to all employees. The second half of the review varies based upon the job code. I have templates for all job codes, using the job code as the name. What I need to do is loop through the list of employees and do the following:
(1) Create a new worksheet named "employee_name" & "_Review.xls"
(2) copy the first template into the new worksheet as sheet1
(3) find the appropriate job code template and copy in the first sheet of that template into the new worksheet
(4) Save the new worksheet as the "employee_name" & "_Review.xls"
(5) loop back and get another employee...

I've got steps 1 and possibly 4 and 5, but could use some pointers / sample code for 2 and 3.

Here's what I have so far... please don't laugh...
Code:
' this is list of emp#, emp name, job code, job desc
Sheets("Department Employees").Select  

' figure max 100 employees per department - could make it larger if needed...
Range("a10:d109").Select    

Do Until ActiveCell = ""

    Emp_no = ActiveCell.Range("a1").Text
    Emp_Name = ActiveCell.Range("b1").Text
    job_code = ActiveCell.Range("c1").Text
    Job_Desc = ActiveCell.Range("d1").Text
    
    SaveAsName = Emp_Name & "_Review.xls"

' replace comma space with underscore...
' name in last, first format...

    SaveAsName = Replace(SaveAsName, ", ", "_", 1)


' create new workbook...
' this is the template for part 1 of the review...
Set NewBook = Workbooks.Add("s:\steve\NHP_Reviews\vbb_default.xlt")

Worksheets("Sheet1").Select

'rename sheet 1 tab with employee name and vbb review...
Worksheets("Sheet1").Name = Emp_Name & "_VBB Review"

' check to see if name used?
existfile = Dir(SaveAsName)

'save with name
ActiveWorkbook.SaveAs Filename:=SaveAsName

' but at this point it only has first half of review...
' need to open the template with job code...

'close new employee specific workbook..

NewBook.Close saveChanges:=False

'move down a row...
    ActiveCell.Offset(1, 0).Range("a1:d1").Select
    
Loop

Thanks
Steve
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,214,901
Messages
6,122,157
Members
449,068
Latest member
shiz11713

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top