macro to extract certain Criteria

[howard]

I have data in Col A and B on sheet "Imported Data"


I only want to extract the following Types to be extracted


Currently only DV Col A and M1 Col B is being extracted

I also need NV and RE to be extracted


It would be appreciated if someone could assist me




Col A Col B
DV M1
NV RE

Book1
	A	B
4	BT	Plan
5	NV	B6
6	NV	E6
7	NV	E6
8	NV	B6
9	NV	B6
10	NV	B6
11	NV	B6
12	NV	B6
13	NV	B6
14	NV	C6
15	NV	C6
16	NV	E6
17	NV	C6
18	NV	B6
19	NV	E6
20	NV	RE
21	NV	B6
22	DV	M1
23	DV	M1
24	DV	M1
25	DV	M1
26	DV	M1
Sheet1

 Sub Extract_Criteria()

Sheets("Imported Data").Select
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

With ActiveSheet.Range("A5:J" & Lastrow)
.AutoFilter Field:=1, Criteria1:=Array("DV", "NV"), Operator:=xlFilterValues
.AutoFilter Field:=2, Criteria1:=Array("M1", "RE"), Operator:=xlFilterValues

.SpecialCells(xlCellTypeVisible).Copy Worksheets("Extracted DVM1_NVRE").Range("A2")
.AutoFilter
End With


End Sub

 

[alansidman]

try this:

Option Explicit


Sub FindX()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Dim lr As Long, i As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("A" & i) = "DV" Then
            If s1.Range("B" & i) = "M1" Then
                s1.Range("A" & i & ":B" & i).Copy s2.Range("A" & lr2 + 1)
            ElseIf s1.Range("A" & i) = "NV" Then
                If s1.Range("B" & i) = "RE" Then
                    s1.Range("A" & i).Copy s2.Range("A" & lr2 + 1)
                End If
            End If
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "completed"
End Sub

 

[howard]

Thanks for the help, Alan