Filter copy incl more than it should

G

goss9394

Hi all
My code below should filter data for criteria and copy data to another
worksheet

However, incl at least 1 row that should not be included
Will incl header row as well depending on rnage I specify

What am I doing wrong here?
Thanks
-goss

Sub pus_Filters()
Dim wbBook As Workbook
Dim wsData As Worksheet
Dim wsDCB As Worksheet
Dim wsSetups As Worksheet
Dim i As Integer
Dim Rng As Range
Dim rngCopyTo As Range
Dim rngCopyFrom As Range
Dim myArray(3) As String

'//Environment
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

'//Objects
Set wbBook = ThisWorkbook
With wbBook
Set wsData = .Worksheets("Data")
Set wsSetups = .Worksheets("Setups")
Set wsDCB = .Worksheets("DCB")
End With
i = 1

'//Processes
'//Load Array
Do While i <= 3
With wsSetups
myArray(i) = .Cells((i + 1), 8)
End With
i = i + 1
Loop


'//Filter and copy
i = 3
Do While i >= 1
With wsData
Set Rng = .Range("A2:L" & Get_Rows)
End With

With Rng
.AutoFilter Field:=12, Criteria1:=myArray(i)
End With

With wsData
Set rngCopyFrom = .Range("A1:L" &
Get_Rows).SpecialCells(xlCellTypeVisible)
End With

With wsDCB
Set rngCopyTo =
..Range("A65536").End(xlUp).Offset(1, 0)
End With

rngCopyFrom.Copy rngCopyTo

With Rng
.AutoFilter
End With

i = i - 1
Loop

'//Cleanup
Set wbBook = Nothing
Set wsData = Nothing
Set wsDCB = Nothing
Set Rng = Nothing
Set rngCopyTo = Nothing
Set rgnCopyFrom = Nothing

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True


End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top