Copy data based on a certain criteria

[Cribbza]

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:



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

[大灰狼1976]

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

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

[Cribbza]

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

Have a great day!