Macro to copy worksheet data to another worksheet based on criteria

[excelvb]

Hi everyone !

Can someody help me create a macro that will search data from a range of cells based on one criteria and copy the entire data to a new worksheet ?

Example I have a list of Channel Names :

Cartoon Network
Disney Channel
CNN
BBC

I want all the Data of CNN to be copied on another worksheet named CNN. The worksheet should be created with a macro.

Here is my code :

Sub NewSheet()

Dim Rang As Range
Dim WS As Worksheet
Set WS = Sheets.Add


Set Rang1 = Workbooks("Channels").Sheets("ORG").Range("A1").CurrentRegion
Set Rang2 = Workbooks("Channels").Sheets("ORG").Range("A1").CurrentRegion

Rang1.AutoFilter Field:=3, Criteria1:="CNN"


Rang1.copy

WS.Name = "CNN"

Sheets("CNN").Activate

ActiveSheet.Paste


Sheets("ORG").Activate


Rang2.AutoFilter Field:=3, Criteria1:="Cartoon Network"

Rang2.copy

WS.Name = "Cartoon Network"

Sheets("Cartoon Network").Activate

ActiveSheet.Paste

Sheets("ORG").Activate


End Sub

Thanks in advance !