Solved: Insert name and auto save as... macro help

I want/need a macro that will use an existing excel file that has a list of employee names in it and have it open an existing blank timecard excel file and have it automatically add the person’s name to it and then save the file as the person’s name and the go to the next person on the list… clear as mud right… thanks for any and all assistance… DRG

Something like this....not tested, but create a template of your time sheet and adjust the worksheets and ranages to suit.
[vba]Sub name_it()
Dim Rng As Range, MyCell As Range, ThisBook As String
ThisBook = ThisWorkbook.Name
Workbooks.Open ("C:\Documents and Settings\gbksxl04\Desktop\" & "testit.xlt")
Set Rng = Workbooks(ThisBook).Sheets("Sheet1").Range("A2:A" & _
Workbooks(ThisBook).Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row)
MsgBox Rng.Address
For Each MyCell In Rng
ActiveWorkbook.Sheets("Sheet1").Range("A1").Value = MyCell.Value
ActiveWorkbook.SaveAs MyCell.Value & ".xls"
ActiveWorkbook.Close
Next MyCell
Workbooks(ThisBook).Activate
Workbooks("testit.xlt").Close False
End Sub[/vba]

Very similar
[VBA]
Sub TimeCard()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\MyPath\"
Application.ScreenUpdating = False
For Each cel In Range("Names")
Set WB = Workbooks.Open(Pth & "Test.xlt")
WB.Sheets(1).Cells(1, 1) = cel
WB.SaveAs Pth & cel & ".xls"
WB.Close
Application.ScreenUpdating = True
Next
End Sub
[/VBA]

Thanks… for the replies… more info. that I should have included in my first post…
There are 150 employees (approx.) and there are a couple of different timecard blanks. One for each different Union. So I would select a group of employee names and apply their info to the correct timecard.

The employee’s are in an excel worksheet named “employee list.xls”
Column A is the person’s employee number
Column B is the person’s name
Column C is the person’s department

I need those three items to be inserted into a timecard.

The time card blank that I need that info put into is named “2010 timecard.xls”
Information is placed on the first tab which is called “TS1”
Cell A,3 is the person’s name
Cell A,4 is the person’s employee number
Cell I,3 is the department

I then want it to save the file as the person’s name and goto the next name on the list.

Thanks so much for the help…DRG

A workbook would help, either that or try to adapt one of the solutions given to you then post back.

I have attached the timecard file... I will try and adapt what you gave me... but i'm hoping someone can help further...thanks_DRG

[VBA]Sub TimeCard()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\MyPath\"
Application.ScreenUpdating = False
For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 timecard.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 8) = cel.Offset(, 2)
.SaveAs Pth & cel & ".xls"
.Close
End With
Application.ScreenUpdating = True
Next
End Sub[/VBA]

I'm close.. but a couple of questions...
If i move the "name" field to the A column and hightlight the names, it creates the time cards... but it removes the word "Department" if front of what is inserted.... and saves the all the files to My Documents folder... I can live with it but I would like the word Department to stay and for the files to be saved in the same folder as the timecard blank and name list... thanks for your help...DRG

I have this working except for one issue. How can i control where the new files are saved to? Currently the code saves the newly created files to the "My Documents" folder... i would like to have it save them to the folder where name list is held... Thanks_DRG

Quote:

---

Originally Posted by pireng

I have this working except for one issue. How can i control where the new files are saved to? Currently the code saves the newly created files to the "My Documents" folder... i would like to have it save them to the folder where name list is held... Thanks_DRG

---

replace this[VBA] Pth = "C:\MyPath\" [/VBA]for your path! like[VBA] Pth = "C:\Names Folder\The Names" [/VBA]

I have the pth statement as the correct folder... "C:\2010 Timecards\"... I don't know where it is coming up with "C:\Documents and Settings\user\My Documents"...to save the new files in...

Can you attach the offending workbook including the code?. md'd code is correct and should save as you expect.

Attached; Name List and below is the code...

Code:

---

Sub CreateAdminTimeCards()
    Dim cel As Range, WB As Workbook, Pth As String
    Pth = "C:\2010 Timecards\"
    Application.ScreenUpdating = False
    For Each cel In Selection
        Set WB = Workbooks.Open(Pth & "2010 Admin.xls")
        With WB
            .Sheets("TS1").Cells(3, 1) = cel
            .Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
            .Sheets("TS1").Cells(3, 9) = cel.Offset(, 2)
            .SaveAs cel & ".xls"
            .Close
        End With
        Application.ScreenUpdating = True
    Next
End Sub

---

Attached Blank Timecard...

I am able to use this the way it is... so its not a big deal, but it would be nice if it would create its own folders based on the department of each employee to save them in...

Thank you for all your help....

This should do you:
[VBA]Sub CreateAdminTimeCards()
Dim cel As Range, WB As Workbook, Pth As String
Pth = "C:\2010 Timecards\"
Application.ScreenUpdating = False
For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 Admin.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 9) = cel.Offset(, 2)
.SaveAs (ActiveWorkbook.Path & "\" & cel & ".xls")
.Close
End With
Application.ScreenUpdating = True
Next
End Sub[/VBA]

Everything works good... only thing that would be helpful is if the file could save itself to a sub folder depending on its department... so if your department from the name list is "Admin" it saves those names to C:\2010 Timecards\Admin and if it is Business it saves them to C:\2010 Timecards\Business and so on....

Thank you for your expertise... it is much appreciated... if this is possible great, if not that is fine too... if you could let me know either way i will then mark this thread as Solved... again Thank you.:clap:

Hi Pireng,
Try modifying this line. Check the location of the data and add it into the string.

[VBA]
.SaveAs (ActiveWorkbook.Path & "\" & cel & ".xls")

[/VBA]

Thanks... unfortunatly every rendition i come up with gives an error... the data is in the third cell, or column C and

Code:

---

.SaveAs (ActiveWorkbook.Path & "\" & cel & ".xls")

---

is obviously the line to add the data too, i just don't know the proper format...

[vba].SaveAs (ActiveWorkbook.Path & "\" & cel.offset(,2) & "\" & cel & ".xls") [/vba]

works like a champ...Thank you!

[VBA]
Sub CreateAdminTimeCards()
Dim cel As Range, WB As Workbook, Pth As String
Dim fs, SubPth As String
Set fs = CreateObject("Scripting.FileSystemObject")
Pth = "C:\2010 Timecards\"
Application.ScreenUpdating = False

SubPth = ActiveWorkbook.Path & "\" & cel.Offset(, 2)
If Not fs.folderexists(SubPth) Then MkDir SubPth

For Each cel In Selection
Set WB = Workbooks.Open(Pth & "2010 Admin.xls")
With WB
.Sheets("TS1").Cells(3, 1) = cel
.Sheets("TS1").Cells(4, 1) = cel.Offset(, 1)
.Sheets("TS1").Cells(3, 9) = cel.Offset(, 2)
.SaveAs (SubPth & "\" & cel & ".xls")
.Close
End With
Application.ScreenUpdating = True
Next
End Sub

[/VBA]

When i run this I get

Run-time error '91':
Object variable or With block variable not set

when i hit debug it highlights this line

Code:

---

SubPth = ActiveWorkbook.Path & "\" & cel.Offset(, 2)

---

Can anyone help with the error i get with this code??

Its so close to doing what i want I hate to give up now...

Thanks