excel - 将数据行从表传输到不同工作表上的表

Question

我是 VBA 的初学者，我的传输数据代码遇到了问题。当日期输入到单元格(列“AD”)时，我试图自动将一行数据从一个表传输到另一个表底部的新行，但是当我尝试它时，数据被传输到表的最后一行 UNDERNEATH 下的行。

Sub TRANSFER_DATA()

For Each Cell In Worksheets("Sheet1").Range("AD2:AD1000")
If Cell.Value > 0 Then
    matchRow = Cell.Row
    Rows(matchRow & ":" & matchRow).Select
    Selection.Cut

    Sheets("Sheet2").Select
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
End If
Next Cell
End Sub

任何帮助将不胜感激，因为我正在失去理智!

Answer 1

如果我理解你的问题，你可以试试这个代码:
当您激活 sheet1 时执行宏

Sub TRANSFER_DATA()
Dim lastrow, i As Long
Dim ADCell as Integer

ADCell=30 ' control the column AD
'control how many data there are in column A. If you want count how many rows
'with ColumnAD change 1 in 30 (lastrow = Cells(rows.count,30).End(xlUp).Row)
lastrow = Cells(rows.count, 1).End(xlUp).Row 
For i = 2 To lastrow
    If Cells(i, ADCell) > 0 Then
        rows(i & ":" & i).Select
        Selection.Cut Worksheets("Sheet2").Range("A" & rows.count).End(xlUp).Offset(1)
    End If
Next i
End Sub

我尝试了代码并且工作正常。

UPDATED THE POST AFTER YOUR COMMENT

Sub TRANSFER_DATA()
Dim lastrow, i, ls As Long
Dim ADCell as Integer

ADCell=30 ' control the column AD
'control how many data there are in column A. If you want count how many rows
'with ColumnAD change 1 in 30 (lastrow = Cells(rows.count,30).End(xlUp).Row)
lastrow = Cells(rows.count, 1).End(xlUp).Row 
For i = 2 To lastrow
    If Cells(i, ADCell) > 0 Then
        rows(i & ":" & i).Select
        Selection.Cut Worksheets("Sheet2").Range("A" & rows.count).End(xlUp).Offset(1)
    End If
Next i
With Sheets("sheet2")

  ls = .Cells(.rows.count, ADCell).End(xlUp).Row
  .ListObjects("TableName").Resize Range("$A$1:$AD$" & ls)

End With

End Sub

更新后的代码还有另一个变量 ls。此变量具有 sheet2 的非空行数。 ListObjects.("name of your table") 将新数据(行)插入到表中。

我希望这有帮助