自動篩選不會返回任何內容，但會將值復制到新的電子表格中

Question

我的下面的過濾器有問題。 當自動篩選器不返回任何內容（即沒有結果）時，它似乎會跨所有內容復制到生成的新電子表格。 如何防止這種情況發生？ 我嘗試過事先插入檢查以查看過濾器后是否有任何值，但是它一直向我返回一個非常大的數字（當它實際上應該返回2時，因為只有標頭行A和B是可見的）。

With ThisWorkbook.Sheets("Master")

        .AutoFilterMode = False
        .Range("A2:Z2").AutoFilter Field:=refColumn, Criteria1:=itm
        .Range("A2:Z2").AutoFilter Field:=26, Criteria1:="Chase them to activate their token"

        ' Check to see if there are any values after the filter
        Dim FilterArea As Excel.Range
        Dim RowsCount As Long
        For Each FilterArea In ThisWorkbook.Sheets("Master").AutoFilter.Range.SpecialCells(xlCellTypeVisible)
            RowsCount = RowsCount + FilterArea.Rows.Count
        Next FilterArea

        ' If there are more than 2 rows then copy user id, first name last name to new spreadsheet
        If RowsCount > 2 Then
        .Range("A3:C" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("A11").PasteSpecial xlPasteValues
        ' Copy and paste email
        .Range("E3:E" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("D11").PasteSpecial xlPasteValues
        End If
    End With

Answer 1

在用於復制內容的代碼中，您使用的是未定義的變量lastrow 。

對於您要實現的目標，可以看一下AdvancedFilter方法。

Answer 2

通過計算可見行的數量來設法解決這個問題：

With ThisWorkbook.Sheets("Master")
        .AutoFilterMode = False
        .Range("A2:Z2").AutoFilter Field:=refColumn, Criteria1:=itm
        .Range("A2:Z2").AutoFilter Field:=26, Criteria1:="Verify if the user is happy with the service and that everything works ok"

        ' If there are more than 1 rows then copy user id, first name last name
        Set VisibleRng = ThisWorkbook.Sheets("Master").AutoFilter.Range
        RowCount = VisibleRng.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1

        If RowCount > 1 Then
        .Range("A3:C" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("A" & NextHeaderRow + 4).PasteSpecial xlPasteValues
        ' Copy and paste email
        .Range("E3:E" & LastRow).Copy
            ActiveWorkbook.Sheets("Sheet1").Range("D" & NextHeaderRow + 4).PasteSpecial xlPasteValues
        End If
    End With