I am trying to copy data from a form and pasting it into a list. Every new form I create will have data copied to the list, in the next blank cell down.
There are six fields on my form that I want to copy but these fields do not always have data in them. The field that is copied into the first column of the list will always have the date in it.
How do I get the macro to select the next free cell in column A and past the data into the respective cells in that row?
The code I have written so far is as follows:
Code
Function FileExists(stFile As String) As Boolean
If Dir(stFile) <> "" Then FileExists = True
End Function
Sub CreateNewJobsheet()
' ceates new job sheet and saves it as the next available number in the series.
Dim wbk1 As Workbook
Dim l As Long
Dim stFileName As String
Dim iRow As Integer
Dim Ws1 As Worksheet, Ws2 As Worksheet
' speed up the macro
With Application
.EnableEvents = False
.ScreenUpdating = False
.AskToUpdateLinks = False
End With
Set wbk1 = Workbooks.Add(template:="Z:\Service\Service Report.xlt") ' location of Service Report template
l = 40000 ' number where reports start. This should be changed if reports are archived
Do
l = l + 1
stFileName = "Z:\Service\" & l & ".xls" ' directory where Job Reports are saved
Loop While FileExists(stFileName)
wbk1.SaveAs Filename:=stFileName
wbk1.ActiveSheet.Name = l ' changes sheet name to job number
Range("E7").Value = Now
Range("E5").Value = l
fmCustomerData.Show
Range("B16").Value = fmCustomerData.cbSiteAddress ' inserts the information
Range("B17").Value = fmCustomerData.tbTenant ' from the form into the
Range("B19").Value = fmCustomerData.tbWorkTaskDescription ' job sheet
Range("B20").Value = fmCustomerData.tbSiteContact
Range("E20").Value = fmCustomerData.tbPhoneNumber
Range("E9").Value = fmCustomerData.tbOrderNumber
Range("B12:B13").Copy
Range("B12:B13").PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
Set Ws1 = Workbooks("" & l & ".xls").Sheets(1)
Set Ws2 = Workbooks("Job Register.xls").Sheets("Register")
'if nothing put initial value for your first row i.e. row 4
Set iRow.Value = 4
Do
If Not IsEmpty(Cells(iRow, 1)) Then
iRow = iRow + 1
Loop
Ws2.Range("A" & iRow) = Ws1.Range("E7").Value
Ws2.Range("B" & iRow) = Ws1.Range("E5").Value
Ws2.Range("C" & iRow) = Ws1.Range("B16").Value
Ws2.Range("D" & iRow) = Ws1.Range("B12").Value
Ws2.Range("F" & iRow) = Ws1.Range("B19").Value
Ws2.Range("G" & iRow) = Ws1.Range("E9").Value
Range("B18").Select
' restore the settings
With Application
.EnableEvents = True
.ScreenUpdating = True
.AskToUpdateLinks = True
End With
wbk1.Save
End Sub
Display More
Also, should I be splitting this into smaller macros and calling them in another macro? Will this speed the process up?
Any assistance is appreciated.
Duncan