Splitting data location wise from 3 sheets in 1 workbook

[Kalpesh93]

hi frds...

I have some queries in vba and m unable to find out the way...

I will try to explain as much as possible...pls check and give me solutions..

I have an excel workbook which contains raw data in 3 different sheets i.e. Sheet1, Sheet2 & Sheet3.

I want to split the data location wise from Sheet1, Sheet2 & Sheet3 in one workbook and that workbook will have all of that data from 3 sheets like Sheet1,Sheet2 & Sheet3.

I would like to split the data from Sheet1 in new workbook for a particular location (will name as "CHD") (Will name the sheet1 as "X"). Again I want to split data from Sheet2 for the same location (Will name the sheet2 as "Y") and the same activity should be done for Sheet3 (Sheet3 name as "Z"). All of the output from the 3 sheets should be saved in one workbook and eventually for all other locations.

Pls note *If any sheet doesn't contains any data for that particular location, lets say CHD location, contains data in Sheet1 & Sheet3 so in output file Sheets remains the same i.e. X , Y , Z (Even if the data is blank)

I am able to split the data from sheet1 in multiple workbooks for different locations but not able patch all those 3 sheets data for one particular location in a new workbook.

I have attached the raw data file...

Code which I am using to split the data:

Sub test_data()
'Jerry Beaucaire  (4/22/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String

'Sheet with data in it
   Set ws = ActiveSheet


'Path to save files into, remember the final \
    SvPath = "C:\discounts\VBA\working\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:Z1"

'Choose column to evaluate from, column A = 1, B = 2, etc.
   vCol = Application.InputBox("What column to split data by? " & vbLf _
        & vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
   If vCol = 0 Then Exit Sub

'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

'Speed up macro execution
   Application.ScreenUpdating = False

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
    For Itm = 1 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)

        ws.Range("A1:A" & LR).EntireRow.Copy
        Workbooks.Add
        Range("A1").PasteSpecial xlPasteAll
        Cells.Columns.AutoFit
        MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1

    Next Itm

End Sub