Как фильтровать потом заполнять на отдельном листе?

Question

Я пытаюсь отфильтровать все, что ниже 70%, для заполнения на отдельном листе.

Изображение того, из чего я вытягиваю.

Я посмотрел онлайн и получил небольшой код.

Вот что у меня есть, и я сталкиваюсь с ошибкой.

Private Sub CommandButton1_Click()

lastrow = Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row

For r = 2 To lastrow
    If Worksheets("sheet1").Range("O" & r).Value < "70%" Then
        Worksheets("sheet1").Rows(r).Copy

        Worksheets("sheet2").Activate
        lastrowrpt = Worksheets("sheet2").Range("O" & Row.Count).End(xlUp).Row
        Worksheets("sheet2").Range("O" & lastrowrpt + 1).Select

        ActiveSheet.Paste

    End If

Next r

End Sub

Answer 1

Это должно помочь вам начать работу

В этом случае вы можете использовать фильтр и видимые ячейки, чтобы скопировать диапазон на другой лист.

Настройте его в соответствии с вашими потребностями

Private Sub CommandButton1_Click()
    Dim sourceSheet As Worksheet
    Dim sourceRange As Range
    Dim sourceFilteredRange As Range

    Dim targetSheet As Worksheet
    Dim targetCell As Range

    Dim cell As Range

    Dim sourceLastRow As Long
    Dim targetLastRow As Long

    ' Define source and target objects
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")
    Set targetSheet = ThisWorkbook.Worksheets("Sheet2")

    ' Get last row of source sheet
    sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    ' Get last row of target sheet
    targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1

    ' Set source range
    Set sourceRange = sourceSheet.Range("A1:O" & sourceLastRow)

    ' Filter source range by route and shipped
    With sourceRange
        .AutoFilter Field:=15, Criteria1:="<70%"
    End With

    ' Get filtered range
    Set sourceFilteredRange = sourceRange.SpecialCells(xlCellTypeVisible)

    ' Copy filtered range to target sheet
    sourceFilteredRange.Copy targetSheet.Range("A" & targetLastRow)

End Sub

Дайте мне знать, если это работает