IF statement loop with Range instead of individual values - excel

Question

First of all thanks for your help.
I've been trying to get a dynamic list that copies values from on excel to another depending on an "IF" condition, which has worked quite fine. But I can only do it for 1 condition instead of a Range of conditions.
In excel I would usually use the COUNTIF function to see if you can find a range of values inside another range, but i am quite new to VBA and I wouldn't know how how to express this in a loop for a Range.
Example below of what has worked with one condition:
As you can see I am using "Investor" as my condition, but I need it to be for a range of values.
Thanks for your help!
LastRows = Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 2 To LastRows
If Worksheets("Data").Range("F" & i).Value = "Investor" Then
'Instead of "Investor" I want to do something that take a list of values. Eg : If If Worksheets("Data").Range("F" & i).Value = "Range("A1:A"&LastRows) Then
Worksheets("Data").Range("A" & i).Copy
Worksheets("Email Format").Activate
LastRowEmail = Worksheets("Email Format").Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Email Format").Range("A" & LastRowEmail).Select
ActiveSheet.Paste
End If

Answer 1

Application.Match Vs WorksheetFunction.Match
You can use one of the following Match solutions.
Option Explicit
Sub MultiCriteria1()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsD As Worksheet: Set wsD = wb.Worksheets("Data")
Dim wsE As Worksheet: Set wsE = wb.Worksheets("Email Format")
Dim LastRowD As Long: LastRowD = wsD.Cells(wsD.Rows.Count, 1).End(xlUp).Row
Dim CurrentE As Long: CurrentE = wsE.Cells(wsE.Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 2 To LastRowD
If Not IsError(Application.Match(wsD.Range("F" & i).Value, _
wsD.Range("A1:A" & LastRowD), 0)) Then
CurrentE = CurrentE + 1
wsE.Range("A" & CurrentE).Value = wsD.Range("A" & i).Value
End If
Next i
End Sub
Sub MultiCriteria2()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsD As Worksheet: Set wsD = wb.Worksheets("Data")
Dim wsE As Worksheet: Set wsE = wb.Worksheets("Email Format")
Dim LastRowD As Long: LastRowD = wsD.Cells(wsD.Rows.Count, 1).End(xlUp).Row
Dim CurrentE As Long: CurrentE = wsE.Cells(wsE.Rows.Count, 1).End(xlUp).Row
Dim CurrVal As Long
Dim i As Long
For i = 2 To LastRowD
On Error Resume Next
CurrVal = WorksheetFunction.Match(wsD.Range("F" & i).Value, _
wsD.Range("A1:A" & LastRowD), 0)
If Err.Number = 0 Then
CurrentE = CurrentE + 1
wsE.Range("A" & CurrentE).Value = wsD.Range("A" & i).Value
End If
On Error GoTo 0
Next i
End Sub

Answer 2

This is just an example but should steer you in right direction.
Dim rngYourRange as Range
Set rngYourRange = Range("A1:C10")
Dim rngEachRange as Range
For each rngEachRange in rngYourRange 'or rngYourRange.Rows or rngYourRange.Columns
if rngEachRange.value = 1 then 'or whatever
'do what you need
end if
next rngEachRange