Фильтровать, вырезать и вставлять из одного листа в другой

Question

У меня есть лист с большим количеством данных. Я хочу использовать автофильтр для столбца A в Testsheet1, затем обрезать всю строку и вставить его в определенный диапазон в Testsheet2.

Sub CutCopyPaste()

    Dim lrow as Long

    lRow = Worksheets("Testsheet1").Range("A" & Rows.Count).End(xlUp).Row

    Worksheets("Testsheet1").Range("A1:A" & lRow).AutoFilter Field:=1, Criteria1:="Test"

    Worksheets("Testsheet1").Range("A1:A" & lRow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Cut Worksheets("Testsheet2").Range("A1")

End Sub

Это прекрасно работает для copy, но я получаю ошибку, используя cut. Ошибка выполнения '438'. Объект не поддерживает эту функцию или метод.

Answer 1

Это сделает работу за вас:

Sub CutCopyPaste()

    Dim lrow As Long
    Dim ws

    Set ws = ThisWorkbook.Sheets("Sheet5")

    With ThisWorkbook.Sheets("Sheet6")
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A1:A" & lrow).AutoFilter Field:=1, Criteria1:="Test"
    End With


    ThisWorkbook.Sheets("Sheet6").Range("A1:A" & lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
    ws.Cells(1, 1).PasteSpecial xlPasteValues

    ThisWorkbook.Sheets("Sheet6").Range("A1:A" & lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete


End Sub

Answer 2

Попробуйте, я проверил и работает:

Option Explicit
Sub CutCopyPaste()

    Dim lrow As Long
    Dim ws

    Set ws = ThisWorkbook.Sheets("TestSheet2")

    With ThisWorkbook.Sheets("Testsheet1")
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row
        .Range("A1:A" & lrow).AutoFilter Field:=1, Criteria1:="Test"
        .Range("A1:A" & lrow).SpecialCells(xlCellTypeVisible).EntireRow.Cut ws.Range("A1")
    End With

End Sub