I have the following macro that is intended to filter the data tab based on the two specified criteria and then paste the remaining lines into the report. The filters work properly but it is pasting even the hidden rows into the report and I can't figure out how to get it to only paste the visible lines. I am pasting my code below. Has anyone experienced this issue before or know how I might resolve it?
Code
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) 'exclude header
End With
End With
Application.CutCopyMode = False 'Clear clipboard
Dim columnsToKeep() As Variant
columnsToKeep = Array(13, 36, 2, 3, 24, 8, 12) 'specify output columns to keep and their order
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
MsgBox "Pass on creation succesful! Please update your comments and print."
End Sub
Display More