Copying from summary worksheet to separate worksheet

[singcbl]

I am getting desperate to find a solution to shorten the time I need to do what I am describing below. I like to use codes for this.

I have a workbook that contains 4 worksheets named as Summary, Hotel, Podium and External. They all have the same layout except only those items relating to the "Hotel" will be in the Hotel worksheet and so on. At times it will be entered as "All" which means this item is to be into all the different worksheets.

Basically the macro needs to do the following.

Look in the Summary worksheet. Select and copy from row 5 onwards (first 4 rows is the headers that I do not to copy over in the other worksheet) when Col A contains either "Hotel" or "All" to the Hotel worksheet. This apply as well to the Podium and External worksheet.

I hope I am clear with my request.

 

[Peter_SSs]

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>

 

[singcbl]

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.

 

[singcbl]

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_SSs]

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.

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

.AutoFilter Field:=1, Criteria1:="*" & mySheet(I) & "*", Operator:=xlOr, _
                Criteria2:="=All"

 

[singcbl]

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