Copy row from one worksheet to another with multiple column criteria

[Alex R]

Hello! I'm looking to copy an entire row from one worksheet (Sheet1) to another (Sheet2) based on multiple criteria.

For example, in the image below, I need to be able to find all the "Green" fruits and then refine that further to only "Medium" Size. Then, I need to copy the entire row (as long as it has both criteria) into a seperate worksheet.

This is a simplified example but currently my code looks something like this:

Private Sub CommandButton_Click()
Dim c As Range
Dim j As Integer

Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("Input") 'name of the actual worksheet
Set Target = ActiveWorkbook.Worksheets("Output") 'name of the actual worksheet

j = 13 'need it to start looking at row 13 of Sheet1
For Each c In Source.Range("B1:B1000") 'needs to work for column B (in the simplified example, search every row in the column "Colour")
If c = "Green" And source.range(c, 3) = "Medium" Then 'find all rows that have both Green (from column B) andMedium (from column c, i.e. 3)
Source.Rows(c.Row).Copy Target.Rows(j) 'copy the rows that match the criteria above to a new worksheet (preferably row 7 if at all possible)
j = j + 1 'repeat for next row!
End If
Next c
End Sub

Many many thanks in advance.

 

[AC PORTA VIA]

try this
data In column A-fruit , B-colour and C-size on sheet1 copy to sheet2

Sub copy_if()
'COPY ENIRE ROW IF COLUMN B (2) CONTAINS "GREEN" AND COLUMN C (3) CONTAINS "MEDIUM""
   Dim LastRow As Long
   LastRow = Range("A" & Rows.Count).End(xlUp).Row
   With ActiveSheet
      .Range("A1:c" & LastRow).AutoFilter 2, "green"
      .Range("A1:c" & LastRow).AutoFilter 3, "medium"
      .AutoFilter.Range.Offset(1).Copy Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
   
      .ShowAllData
   End With
End Sub