Переберите таблицу и скопируйте непустые строки на другой лист

Question

У меня есть таблица «Table1», которая содержит все заказы, которые мы выполняем. Я хотел бы пройтись по этой таблице, чтобы найти строки с указанным временем завершения, и переместить их в заполненную таблицу на другом листе. Так что он должен пройтись по таблице, проверить, если столбец времени завершения пуст. Это столбец 8 в таблице и столбец J в рабочей книге.

Я испробовал несколько рекомендаций, найденных на стеке и других сайтах, но, похоже, ничего не работает. Следующий код не возвращает ошибку, но ничего не делает.

Sub closeItems()
    Dim i, iLastRow As Integer
    Dim oLastRow As ListRow

    iLastRow = ActiveSheet.ListObjects("Table1").ListRows.Count

    For i = 1 To iLastRow
        If Cells(i, 8).Value <> vbNullString Then
            Rows(i).Copy
            Set oLastRow = Worksheets("Finished").ListObject("Finished").ListRows.Add
            Application.CutCopyMode = False
            Rows(i).EntireRow.Delete
        End If
    Next
End Sub

Я хотел бы переместить заполненные записи в завершенную таблицу и удалить строку из активной таблицы.

Answer 1

Вот опция, которая фильтрует, копирует и удаляет

Sub closeItems()

Dim tb1 As ListObject
Dim tb2 As ListObject
Dim Lrow As Long

Set tb1 = ActiveSheet.ListObjects("Table1")
Set tb2 = Worksheets("Finished").ListObjects("Finished")
Lrow = tb2.ListRows.Count

tb1.Range.AutoFilter Field:=8, Criteria1:="<>" & vbNullString
NumRows = tb1.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Rows.Count
tb1.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Copy
tb2.DataBodyRange(Lrow + 1, 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False


Application.DisplayAlerts = False
tb1.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True

End Sub