Ошибка 438 - «Объект не поддерживает это свойство или метод». Попытка копирования из одной таблицы в другую на основе условия.

Question

У меня практически нет опыта работы с VBA. Просто пытаюсь скопировать данные из одной таблицы и вставить во вторую таблицу без копирования каких-либо данных. Он копирует данные и удаляет ячейки, но не может найти таблицу для вставки. Любая помощь будет признательна.

 Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim Table2 As Range

Set Sheet1 = Worksheets("Sheet1")
Set Sheet2 = Worksheets("Sheet2")
Set Table2 = Range("a2:c10")

a = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Sheet1.Cells(i, 2).Value = 1001 Then

Sheet1.Rows(i).Cut
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Paste

End If
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Answer 1

Сообщение об ошибке появляется просто из-за того, что Range не имеет Paste -метода. У него есть PasteSpecial -метод, вы можете использовать его, но есть гораздо более простой способ копирования данных из одного диапазона в другой: при запуске метода Cut (или Copy) укажите целевой диапазон как 2-й параметр.

Теперь метод VBA Cut очищает содержимое диапазона источника, не удаляя ячейки. Если вы хотите удалить строки, вы должны ввести Delete -условие. И если дело доходит до удаления чего-либо из списка, всегда l oop назад (см., Например, VBA не удаляет пустые ячейки ).

Ваш код может выглядеть следующим образом:

Dim rowCount as long, row as long
rowCount = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For row = rowCount To 2 step -1
    If Sheet1.Cells(row , 2).Value = 1001 Then
        Sheet1.Rows(row ).Cut Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        ' If you want to Delete the row in Sheet 1:
        Sheet1.Rows(row).Delete 
    End If
Next