Apply filter on the basis of multiple values

[Tejas Kore]

I have this data .
[TABLE="width: 128"]
<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>[TR]
[TD="width: 64"]Country[/TD]
[TD="width: 64"]Name[/TD]
[/TR]
[TR]
[TD]India[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]India[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]India[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]Australia[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]Australia[/TD]
[TD]E[/TD]
[/TR]
[TR]
[TD]Peru[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]Peru[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]Chile[/TD]
[TD]H[/TD]
[/TR]
[TR]
[TD]Chile[/TD]
[TD]I
[/TD]
[/TR]
</tbody>[/TABLE]

Now I want to apply filter to this data in such a way that India And Australia comes in one category and Peru And Chile comes in another.
Right now I have the code to split this file in 4 files , each one corresponding to one country.
How can I apply multiple search criteria to Column A which is the column containing Countries ?

Here is the code :

Sub Sample()


Dim wswb As String
Dim wssh As String


wswb = ActiveWorkbook.Name
wssh = ActiveSheet.Name


vcolumn = InputBox("Please indicate which column,you would like to split by", "Column Selection")
Columns(vcolumn).Copy
Sheets.Add
ActiveSheet.Name = "_Summary"
Range("A1").PasteSpecial
Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
vCounter = Range("A" & Rows.Count).End(xlUp).Row


For i = 2 To vCounter
vfilter = Sheets("_Summary").Cells(i, 1)
Sheets(wssh).Activate
ActiveSheet.Columns.AutoFilter field:=Columns(vcolumn).Column, Criteria1:=vfilter
Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial
If vfilter <> "" Then
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\split results" & vfilter
Else
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\split results\_Empty"
End If
ActiveWorkbook.Close
Workbooks(wswb).Activate


Next i


Cells.AutoFilter
Application.DisplayAlerts = False
Sheets("_Summary").Delete


End Sub

 

[Sektor]

Sub F()
    With Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:=Array("India", "Australia"), Operator:=xlFilterValues
        .Copy Sheets.Add().Cells(1)
    End With
End Sub

 

[Tejas Kore]

code deleted per OP request