将数据复制到另一个工作表中的第一个空白行，仅当第一列不为空时（数据量变化）

Question

我希望能够按一个按钮从表格中复制一些数据＆＃34;数据输入＆＃34;到另一张纸的第一个空白行＆＃34;数据库＆＃34;。

但是，如果第一列是空白的，我不希望复制该行数据。此外，有时候＆＃34;数据输入＆＃34;工作表可能有4行数据，有时可能有5,6,7或8。

我已在下面附上截图。

到目前为止我使用的代码没有给出任何错误，但似乎也没有发生任何错误。

Private Sub CommandButton1_Click()

    Dim cl As Range    
    For Each cl In Sheet2.Range("A8:A23")

        If Not IsEmpty(ActiveCell.Value) Then

            Range("A" & ActiveCell.Row & ":R" & ActiveCell.Row).Select
            Selection.Copy
            Sheets("Database").Select
            ActiveCell.End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste

        End If    
    Next cl
End Sub

Answer 1

您当前的代码经常引用ActiveCell（在第一次迭代之后[如果它到达那么远]，是“数据库”表单上的单元格！），而不是A8范围内的单元格：Sheet2的A23。

重构代码可以是：

Private Sub CommandButton1_Click()
    Dim cl As Range

    For Each cl In Sheet2.Range("A8:A23")
        If Not IsEmpty(cl.Value) Then
            With Worksheets("Database") ' to make it easier to refer to the sheet
                'Find last cell in column A, 
                ' go to the row below,
                ' extend the range to be 18 columns wide,
                ' set values to be values on Sheet2
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 18).Value = cl.Resize(1, 18).Value
            End With
        End If
    Next
End Sub

Answer 2

我做这样简单的事情。这可能不如其他一些方法有效，但它应该做你想要的。此外，该范围不会被硬编码，并会随着数据行数的变化而变化。

Dim lastRowDataEntry As Integer
Dim lastRowDatabase As Integer
Dim a As Integer

'Find the last row of data in each sheet
lastRowDataEntry = Sheets("Data Entry").Range("B" & Rows.Count).End(xlUp).Offset(0).Row


For a = 8 To lastRowDataEntry
    If IsEmplty(Sheets("Data Entry").Cells(a, "A").Value) = True Then GoTo ReadyForNexta
    Row(a).Select
    Selection.Copy
    lastRowDataBase = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Offset(0).Row
    Sheets("Database").Cells(lastRowDatabase, "A").Select
    ActiveSheet.Paste

ReadyForNexta:

Next a