Copying from summary worksheet to separate worksheet

singcbl

See if this does what you want:

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> ExtractData()
    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
    
    mySheet = Array("Hotel", "Podium", "External")
    lr = Sheets("Summary").Range("A" & Rows.Count).End(xlUp).Row
    Application.EnableEvents = <SPAN style="color:#00007F">False</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN>
    <SPAN style="color:#00007F">For</SPAN> i = 0 <SPAN style="color:#00007F">To</SPAN> 2
        <SPAN style="color:#00007F">With</SPAN> Sheets("Summary").Rows("4:" & lr)
            .AutoFilter Field:=1, Criteria1:=mySheet(i), Operator:=xlOr, _
                Criteria2:="=All"
            Sheets("Summary").Rows("5:" & lr).Copy _
                Destination:=Sheets(mySheet(i)).Range("A5")
            .AutoFilter
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> i
    Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN>
    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Peter,

Thanks for your help. I will try it out once I am back in the office tomorrow.
As I do not have any formal training with vba I would appreciate very much if you can give a little explanation note to what your codes does.

Peter,

Your codes works to a certain extend but it is not the fault of the code but more because of the criteria entry. I have told you that the criteria entry is limited to Hotel, Podium, External and All but at times the entry may be entered as "Hotel, Podium" or "Hotel, External" or "Podium, External". How then do I ensure that as long as there is an entry of "Hotel" in any combination this will be copied into the Hotel worksheet and this apply to the other as well.

Peter,

Your codes works to a certain extend but it is not the fault of the code but more because of the criteria entry. I have told you that the criteria entry is limited to Hotel, Podium, External and All but at times the entry may be entered as "Hotel, Podium" or "Hotel, External" or "Podium, External". How then do I ensure that as long as there is an entry of "Hotel" in any combination this will be copied into the Hotel worksheet and this apply to the other as well.

Click to expand...

Try just replacing the similar line with this and let us know if this is OK:

Peter,

It seem to work just fine but I have added the following codes to clear the sheet before copying over. This prevent duplication of data.

Sheets("Hotel").Range("a510000").ClearContents
Sheets("Podium").Range("a510000").ClearContents
Sheets("External").Range("a510000").ClearContents