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
Merging data to create new Spreadsheets
-
- StarLounger
- Posts: 75
- Joined: 09 Feb 2010, 04:55
Merging data to create new Spreadsheets
You do not have the required permissions to view the files attached to this post.
Randy
-
- Administrator
- Posts: 78241
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Merging data to create new Spreadsheets
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.
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
Hans
-
- StarLounger
- Posts: 75
- Joined: 09 Feb 2010, 04:55
Re: Merging data to create new Spreadsheets
You are most awesome as usual Hans! Thanks a million and one...
Randy