Перенос строки данных из таблицы в таблицу на другом листе

Question

Я новичок в VBA, и у меня возникла проблема с моим кодом передачи данных.Я пытаюсь перенести автоматический перенос строки данных из одной таблицы в новую строку в нижней части другой таблицы, когда в ячейку вводится дата (столбец «AD»), однако, когда я пытаюсь это сделать, данные переносятся встрока ПОД последней строкой таблицы.

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

Я попробовал код и работает.

ОБНОВЛЕНОПОСЛЕ ПОСЛЕ ВАШЕГО КОММЕНТАРИИ

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. («Имя вашей таблицы») вставляет новые данные (строки) в таблицу.

Надеюсь, это поможет