VBA Code for Excel-Copy rows to a new worksheet based on two criteria

[jbeb824]

Hey there,

I need help with VBA code for one of my excel workbooks. I would like to copy certain rows from one of my worksheets into a new worksheet (within the same workbook) based on specific criteria.

The 1st worksheet containing the information has 13 columns(Starting with B) and multiple rows(Starting with 3). If the row meets two criteria (from columns D and L) I would like those full rows to populate onto a new worksheet.

I am pretty new to VBA so if someone could help me with this I would really appreciate it!

Thank you for your time!!

 

[stnkynts]

What are the two criteria you would like to have met?

 

[AlphaFrog]

Here's a start. You will have to modify to suit.

Sub Copy_Rows()
    
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim Lastrow As Long, Nextrow As Long
    
    Set ws1 = Sheets("Sheet1")  ' Source worksheet
    Set ws2 = Sheets("Sheet2")  ' Destination worksheet
    
    ' Last used row on source sheet
    Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row
    
    ' Next available row on destination sheet
    Nextrow = ws2.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
    If Nextrow < 5 Then Nextrow = 5
    
    Application.ScreenUpdating = False
    
    ' Filter source on columns D and L
    ws1.Cells.AutoFilter Field:=4, Criteria1:="Dog"     ' Filter column D for "Dog"
    ws1.Cells.AutoFilter Field:=12, Criteria1:=">=10"   ' Filter column L for values greater than 10
    
    ' Copy filtered rows from source to next available row on destination
    ws1.Range("B3:N" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=ws2.Range("A" & Nextrow)
    
    ' Clear filter
    ws1.AutoFilterMode = False
    
    Application.ScreenUpdating = True
    
End Sub

 

[jbeb824]

Thank you for your quick response!

The two criteria that I want it to meet are that it says "New" in column L and that the number in column D is greater than 300001.

I made a few changes to the code, but I'm not sure what other modifications need to be made:

Sub Autpen()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim Lastrow As Long, Nextrow As Long

Set ws1 = Sheets("Sheet1") ' Source worksheet
Set ws2 = Sheets("Sheet2") ' Destination worksheet

' Last used row on source sheet
Lastrow = ws1.Cells.Find("*", , , , xlByRows, xlPrevious).Row

' Next available row on destination sheet
Nextrow = ws2.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5

Application.ScreenUpdating = False

' Filter source on columns D and L
ws1.Cells.AutoFilter Field:=4, Criteria1:="New" ' Filter column L for "New"
ws1.Cells.AutoFilter Field:=12, Criteria1:=">=300001" ' Filter column D for values greater than 300001

' Copy filtered rows from source to next available row on destination
ws1.Range("B3:N3" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=ws2.Range("A" & Nextrow)

' Clear filter
ws1.AutoFilterMode = False

Application.ScreenUpdating = True

End Sub

I am getting runtime error '91' and then it points out the line under Next Available row on destination sheet. I'd appreciate help to clear up this problem and if anyone notices other problems with it. Thanks so much for the help!

 

[AlphaFrog]

D is the 4th column and L is the 12th column

' Filter source on columns D and L
ws1.Cells.AutoFilter Field:=[COLOR="Red"]12[/COLOR], Criteria1:="New" ' Filter column L for "New"
ws1.Cells.AutoFilter Field:=[COLOR="Red"]4[/COLOR], Criteria1:=">=300001" ' Filter column D for values greater than 300001

If Sheet2 is starting out with all cells completely empty, then just set Nextrow = 5 e.g.

Replace this...

' Next available row on destination sheet
Nextrow = ws2.Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
If Nextrow < 5 Then Nextrow = 5

With this...

Nextrow = 5

 

[jbeb824]

I got it working! Thank you so much
I really appreciate all of the help and the quick, detailed responses!!!