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:
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
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.