Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
split data to different Excel files
Dear group members,
My need is to parse Excel file. I have names of departments in F column: aa ab ac df (et cetera, 30 departments) I have list of departments and other information in my source Excel file. My task is: 1) copy three first lines of sheet "as is" 2) copy all strings with "aa" in F column, 3) paste to other Excel file and to save it as C:\destination\aa.xls Then to do the same for "ab", "ac" and all the rest 30 departments. Tell me please how do I perform this. Thank you. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
split data to different Excel files
paste this code into a standard module
i assume dept names start at F4, since rows 1-3 are being replicated? Option Explicit Sub moveCopy() Dim text As String Dim cells As Range Dim wb As Workbook Dim ws As Worksheet Dim rowindex As Long Do While Range("F4") < "" text = Range("F4") With ActiveSheet Set cells = Columns(5).cells.Find(text) Do While Not cells Is Nothing If wb Is Nothing Then Set wb = Workbooks.Add() Set ws = wb.ActiveSheet .Range("1:3").Copy ws.Range("A1").PasteSpecial xlValues rowindex = 4 End If .Rows(cells.Row).Copy ws.cells(rowindex, 1).PasteSpecial xlValues rowindex = rowindex + 1 .Rows(cells.Row).Delete Set cells = .cells.Find(text) Loop If Not wb Is Nothing Then wb.SaveAs text wb.Close False Set wb = Nothing Set ws = Nothing End If End With Loop End Sub "George" wrote in message ... Dear group members, My need is to parse Excel file. I have names of departments in F column: aa ab ac df (et cetera, 30 departments) I have list of departments and other information in my source Excel file. My task is: 1) copy three first lines of sheet "as is" 2) copy all strings with "aa" in F column, 3) paste to other Excel file and to save it as C:\destination\aa.xls Then to do the same for "ab", "ac" and all the rest 30 departments. Tell me please how do I perform this. Thank you. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
split data to different Excel files
Change the Folder in the code as required and the Name of the Summary Sheet.
The macro copies the 1st 3 header rows to the new worksheet and erach department to a new workbook. It stores the workbook using the department name and puts all the files into Folder specified in the code. The new worksheet name is also the department name. The code uses Autofilter to get each of the unique department names. It creates in column IV the unique department names. Then the code sets the autofilter to each department and copies the visible cells (on the filtered items) starting in row 4 to the new workbook. Sub Departments() Folder = "c:\Temp\" Set SourceSht = ThisWorkbook.Worksheets("Summary") With SourceSht LastRow = .Range("F" & Rows.Count).End(xlUp).Row 'get a unique list of departments and put in column IV .Range("F4:F" & LastRow).AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=.Range("IV1"), _ Unique:=True 'set autofilter .Columns("F").AutoFilter 'Set header rows to copy 'don't include column IV with list of departments Set HeaderRows = .Range("A1:IU3") 'set range of data to copy 'will only copy visible cells starting in row 4 'don't include column IV with list of departments Set CopyRange = .Range("A4:IU" & LastRow) 'get row of last department row LastDeptRow = .Range("IV" & Rows.Count).End(xlUp).Row 'the advance filter sometimes makes the 1st two 'items the same so skip the 1st item if it equals 'the 2nd If .Range("IV1") = .Range("IV2") Then StartRow = 2 Else StartRow = 1 End If For DepartmentRow = StartRow To LastDeptRow 'set autofilter to all .Range("F1").AutoFilter _ field:=1, _ VisibleDropDown:=True Department = .Range("IV" & DepartmentRow) If Department < "" Then 'create new workbook with one worksheet Set NewBk = Workbooks.Add(template:=xlWBATWorksheet) Set NewSht = NewBk.Sheets(1) 'add department name to worksheet NewSht.Name = Department 'set autofilter for each department .Range("F1").AutoFilter _ field:=1, _ Criteria1:=Department, _ VisibleDropDown:=True 'copy header rows to new worksheet HeaderRows.Copy Destination:=NewSht.Range("A1") 'Copy data to new sheet CopyRange.SpecialCells(xlCellTypeVisible).Copy _ Destination:=NewSht.Range("A4") 'save new workbook in folder NewBk.SaveAs Filename:=Folder & Department & ".xls" NewBk.Close savechanges:=False End If Next DepartmentRow 'delete the list of departments Columns("IV").Delete End With End Sub "George" wrote: Dear group members, My need is to parse Excel file. I have names of departments in F column: aa ab ac df (et cetera, 30 departments) I have list of departments and other information in my source Excel file. My task is: 1) copy three first lines of sheet "as is" 2) copy all strings with "aa" in F column, 3) paste to other Excel file and to save it as C:\destination\aa.xls Then to do the same for "ab", "ac" and all the rest 30 departments. Tell me please how do I perform this. Thank you. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
split data to different Excel files
Can't you just use datafilterautofilter to work with it as is?
If you insist. As has been suggested by Joel, I would use advanced filter to make a unique listdo a for each loop for each item in the unique list to filter the sheet and then copy the visible to a new wb. -- Don Guillett Microsoft MVP Excel SalesAid Software "George" wrote in message ... Dear group members, My need is to parse Excel file. I have names of departments in F column: aa ab ac df (et cetera, 30 departments) I have list of departments and other information in my source Excel file. My task is: 1) copy three first lines of sheet "as is" 2) copy all strings with "aa" in F column, 3) paste to other Excel file and to save it as C:\destination\aa.xls Then to do the same for "ab", "ac" and all the rest 30 departments. Tell me please how do I perform this. Thank you. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
split data to different Excel files
I might do it this way.
Option Explicit Sub MakeWorkbooksFromUniqueList() Dim lr, lc, lclr As Long Dim c As Range Application.ScreenUpdating = False lr = Cells.Find(What:="*", After:=[A1], _ SearchDirection:=xlPrevious).Row - 3 lc = Cells(1, Columns.Count).End(xlToLeft).Column Cells(4, "f").Resize(lr).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Cells(1, lc + 1), Unique:=True lclr = Cells(Rows.Count, lc + 1).End(xlUp).Row On Error Resume Next For Each c In Cells(2, lc + 1).Resize(lclr - 1) With Range("a4").Resize(lr, lc) ..AutoFilter Field:=6, Criteria1:=c Range("a1").Resize(lr, lc).SpecialCells(xlCellTypeVisible).Copy Workbooks.Add Template:="Workbook" With Range("A1") .PasteSpecial Paste:=xlPasteColumnWidths .PasteSpecial Paste:=xlPasteAll .Select End With ActiveWorkbook.SaveAs Filename:=c ActiveWorkbook.Close .AutoFilter End With Next c Columns(lc + 1).Clear Application.ScreenUpdating = True End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "George" wrote in message ... Dear group members, My need is to parse Excel file. I have names of departments in F column: aa ab ac df (et cetera, 30 departments) I have list of departments and other information in my source Excel file. My task is: 1) copy three first lines of sheet "as is" 2) copy all strings with "aa" in F column, 3) paste to other Excel file and to save it as C:\destination\aa.xls Then to do the same for "ab", "ac" and all the rest 30 departments. Tell me please how do I perform this. Thank you. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
split data to different Excel files
See
http://www.rondebruin.nl/copy5.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "George" wrote in message ... Dear group members, My need is to parse Excel file. I have names of departments in F column: aa ab ac df (et cetera, 30 departments) I have list of departments and other information in my source Excel file. My task is: 1) copy three first lines of sheet "as is" 2) copy all strings with "aa" in F column, 3) paste to other Excel file and to save it as C:\destination\aa.xls Then to do the same for "ab", "ac" and all the rest 30 departments. Tell me please how do I perform this. Thank you. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Split an Excel file into separate files | Excel Programming | |||
Macro to split excel file into seperate files and then email | Excel Discussion (Misc queries) | |||
Macro to split up Excel files that are larger then 65,000 rows Options | Excel Programming | |||
split one excel into two files. | Excel Discussion (Misc queries) | |||
Can I split up an excel spreadsheet into multiple files by rows? | Excel Discussion (Misc queries) |