宏自动过滤器会将隐藏的行粘贴到目标。我被卡住了

Question

我下面有以下代码来过滤源数据并将其转储到报告中。过滤器可以正常工作，但是当结果粘贴到目标位置时，它包括隐藏的行，从而使过滤无效。我不知道如何解决它。我将不胜感激任何帮助。

Public Sub CreatePassOn()



Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Const filterField1 As Long = 8               
Const filterField2 As Long = 27             
Const criterion1 As String = "QC-Completed"
Const criterion2 As String = vbNullString


Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Data")
Set wsTarget = wb.Worksheets("Pass On")

Dim lastRowSource As Long
lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

Dim lastColumnSource As Long
lastColumnSource = wsSource.Range("A1").SpecialCells(xlCellTypeLastCell).Column

Dim filterRange As Range
Set filterRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRowSource, lastColumnSource))

wsSource.AutoFilterMode = False
Dim dataArray As Variant

With filterRange

     .AutoFilter
    .AutoFilter Field:=filterField1, Criteria1:="<>" & criterion1, Operator:=xlFilterValues
    .AutoFilter Field:=filterField2, Criteria1:=criterion2

    With wsSource.AutoFilter.Range

         dataArray = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 

    End With

End With

Application.CutCopyMode = False           

Dim columnsToKeep() As Variant
columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12) 

Dim currentRow As Long
Dim currentColumn As Long
Dim resultArray() As Variant
ReDim resultArray(1 To UBound(dataArray, 1), 1 To UBound(columnsToKeep) + 1)
Dim columnCounter As Long

For currentRow = LBound(dataArray, 1) To UBound(dataArray, 1)

    columnCounter = 0

    For currentColumn = LBound(columnsToKeep) To UBound(columnsToKeep)

        columnCounter = columnCounter + 1
        resultArray(currentRow, columnCounter) = dataArray(currentRow, columnsToKeep(currentColumn))

    Next currentColumn

Next currentRow

wsTarget.Range("A2").Resize(UBound(resultArray, 1), UBound(resultArray, 2)) = resultArray

结束子