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
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