I am trying to create a sub that copies information from one form (which has four cells) to another sheet.
- When it copies the information it also creates a new row.
- Each form has a maximum of ten rows but it should be able to
recognize when a form has empty cells and stop.
- It should also be easy to replicate to other forms.
A sample of the forms can be seen using the link below.
Here is my code which does not work
Sub Update_1() Dim lastrow As Long, erow As Long lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row For i = lastrow To 3 Sheet1.Cells(i, 1).Copy erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row Sheet1.Paste Destination:=Sheet2.Cells(erow, 2) Sheet1.Cells(i, 2).Copy Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 1) Sheet1.Cells(i, 3).Copy Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 8) Sheet1.Cells(i, 4).Copy Sheet1.Paste Destination:=Worksheets("Sheet2").Cells(erow, 3) Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Sheets("Sheet1").Select Next i End sub
This will do the trick:
Public Sub allergy_copy() Dim wkb As Workbook Dim wks As Worksheet Dim wks1 As Worksheet Set wkb = ThisWorkbook Set wks = wkb.Sheets(1) Set wks1 = wkb.Sheets(2) endrows = False thisrow = 3 While endrows = False If wks.Cells(thisrow, 1) <> "" Then With wks .Rows(thisrow).Copy Destination:=wks1.Rows(thisrow) thisrow = thisrow + 1 End With Else endrows = True End If Wend End Sub