I have a spreadsheet (job register) which is used to record all our jobs and the job numbers. I want to automate it so that various data is recorded on the job register and also transferred to a separate job sheet. Here is where it gets tricky; I want to copy the job number onto a new workbook (that is created from a template) and save this workbook as the job number.
The code I have so far is ...
Code
Sub NewJob()
Dim Wbk1 As Workbook
Dim lJobNumber As Long
Dim lRow As Long
Dim iColumn As Integer
Dim stFileName As String
Dim oWbk As Workbook
Dim Ws1 As Workbook, Ws2 As Workbook
With Application
.EnableEvents = False
.ScreenUpdating = False
.AskToUpdateLinks = False
End With
Range("A6:a65536").Find(What:="", After:=Range("A6:a65536").Cells(1), LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
' Do Until Range(Cells(lRow, 1)).Value = ""
' lRow = lRow + 1
' Range(Cells(lRow, 1)).Value = Now
' Loop
With ActiveCell
.Value = Now
.Offset(rowOffset:=0, columnOffset:=1).Activate
End With
' lJobNumber = "41000"
With ActiveCell
.FormulaR1C1 = "=R[-1]C+1"
.Copy
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
UserForm1.Show ' inserts the information from the form into the job register
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = UserForm1.ComboBox1 'site address
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = UserForm1.tbTenant ' tenant
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = UserForm1.tbWorkTaskDescription 'work to be carried out
ActiveCell.Offset(rowOffset:=0, columnOffset:=2).Activate
ActiveCell.Value = UserForm1.tbOrderNumber ' order number for work
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = UserForm1.tbSiteContact 'person on site to contact
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
ActiveCell.Value = UserForm1.tbPhoneNumber ' phone number of contact
ActiveCell.Offset(rowOffset:=0, columnOffset:=-7).Activate
' GetLastUsedCell (1)
' Application.CutCopyMode = xlCopy
' Set lJobNumber.Value = 10
Set Wbk1 = Workbooks.Add(template:="C:\Temp\Templates\Service Report.xlt") ' location of Service Report template
'l = 40000 ' number where reports start. This should be changed if reports are archived
'Set Ws1 = Workbooks("" & lJobNumber & ".xls").Sheets(1)
Set Ws2 = Workbooks("C:\Temp\tempjobregister.xls").Sheets("Register")
Range("Service_Job_Number").PasteSpecial xlPasteValues
Range("E7").Value = Now
Range("e9").Value = UserForm1.tbOrderNumber
' Do
' lJobNumber = lJobNumber + 1
' stFileName = "C:\Temp\Job Reports\" & lJobNumber & ".xls" ' directory where Job Reports are saved
' Loop While FileExists(stFileName)
' wbk1.SaveAs Filename:=stFileName
' wbk1.ActiveSheet.Name = lJobNumber
' Range("E5").Value = lJobNumber
End Sub
Display More