Copy data based on a certain criteria

Hello,

I am trying to create a risk evaluation work-flow in Excel using VBA but I am very new to this and would like some help from you pros on this site. :)

The work-flow is as follows:
1. Open Excel
2. On first Worksheet choose an option (checkboxes - "Security","Quality","Environment" etc. - with combinations as well)
3. On the second Worksheet a list of risks has been generated based on the previous options that were chosen
(It is generated from a seperate workbook based on the criteria "yes". For example: Column A2 = "yes" - then all the cells on that row should be copied).

So far I have been able to copy a range based on a critera. Although it only work if I'm placed in the Worksheet "Risk database" I am copying from when I am running my sub. Here is my current code:

Code:

---

Sub Copy()

Application.ScreenUpdating = False

Worksheets("Sheet2").UsedRange.Offset(1).ClearContents

With Worksheets("Risk database")
    .AutoFilterMode = False
    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .AutoFilter 1, "yes"
        On Error Resume Next
        .Offset(1).EntireRow.Copy
        Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Application.CutCopyMode = False
Worksheets("Sheet2").Select

End Sub

---

(I am using Excel 2016 on the latest Windows software. )

Thank you for your help :)

Hi, Cribbza!
"Copy" is a system reserved word. It's better not to use it as a process name.

Code:

---

Sub Copy_1()
Application.ScreenUpdating = False
Worksheets("Sheet2").UsedRange.Offset(1).ClearContents
With Worksheets("Risk database")
    .AutoFilterMode = False
    With .Range("A1", .Range("A" & Rows.Count).End(xlUp)) '-->edited
        .AutoFilter 1, "yes"
        On Error Resume Next
        .Offset(1).EntireRow.Copy
        Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    End With
    .AutoFilterMode = False
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
Worksheets("Sheet2").Select
End Sub

---

Thanks for the help, the code works now! :)

Have a great day!