Merging data to create new Spreadsheets

User avatar
rettingr
StarLounger
Posts: 75
Joined: 09 Feb 2010, 04:55

Merging data to create new Spreadsheets

Post by rettingr »

Is there a way to take data from one spreadsheet and merge to another (sort of a mail merge) to fill in certain cells and create a new single sheet spreadsheet? I am attaching the sample data I wish to use to create multiple timecards for each employee on the second tab using the first tab as a template. I want to macro or VBA to fill in the Employee ID, Name and Workcenter from the second tab, create a new separate spreadsheet and save it with the employee name as the file name. The real one will have an employee list of over 50 people, so you can see how this will save time each month. Each month, I will update the employee list, update the calendar and run the macro to create a new set of timecards. Easy, right? Any help would be appreciated.

Thanks
Randy
You do not have the required permissions to view the files attached to this post.
Randy

User avatar
HansV
Administrator
Posts: 78241
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Merging data to create new Spreadsheets

Post by HansV »

Welcome to Eileen's Lounge!

Try the following macro. It assumes that the workbook has the structure of the one you attached, and that the macro is stored in it.

Code: Select all

Sub CreateEmployeeSheets()
  ' Modify as needed but keep trailing backslash
  Const strPath = "H:\Excel\"

  Dim wshE As Worksheet
  Dim wshT As Worksheet
  Dim wbkN As Workbook
  Dim wshN As Worksheet
  Dim r As Long
  Dim m As Long

  On Error GoTo ErrHandler
  Application.ScreenUpdating = False

  Set wshE = ThisWorkbook.Worksheets("Employees")
  Set wshT = ThisWorkbook.Worksheets("Timecard")
  ' Last row
  m = wshE.Cells(wshE.Rows.Count, 1).End(xlUp).Row
  ' Loop through employees
  For r = 2 To m
    ' Copy timesheet
    wshT.Copy
    Set wbkN = ActiveWorkbook
    Set wshN = wbkN.Worksheets("Timecard")
    ' Fill in values
    wshN.Range("B3") = wshE.Range("A" & r)
    wshN.Range("F3") = wshE.Range("C" & r)
    wshN.Range("B5") = wshE.Range("B" & r)
    ' Close and save new workbook
    wbkN.Close SaveChanges:=True, Filename:=strPath & wshE.Range("C" & r)
  Next r

ExitHandler:
  Application.ScreenUpdating = True
  Exit Sub

ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub
Best wishes,
Hans

User avatar
rettingr
StarLounger
Posts: 75
Joined: 09 Feb 2010, 04:55

Re: Merging data to create new Spreadsheets

Post by rettingr »

You are most awesome as usual Hans! Thanks a million and one...
Randy