将单元格复制到另一张表并为复制的单元格插入行

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