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
Bookmarks