Копирование ячеек на другой лист и вставка строк для скопированных ячеек

Question

Я пытаюсь создать подпрограмму, которая копирует информацию из одной формы (которая имеет четыре ячейки) на другой лист.

• Когда он копирует информацию, он также создает новую строку.
• Каждая форма имеет максимум десять строк, но она должна иметь возможность распознавать, когда форма имеет пустые ячейки, и останавливаться.
• Это также должно быть легко скопировать в другие формы.

Образец форм можно увидеть по ссылке ниже.

Вот мой код, который не работает

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

Answer 1

Это сделает свое дело:

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