View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tom Hutchins Tom Hutchins is offline
external usenet poster
 
Posts: 1,069
Default How to automatically create and populate worksheets?

Here is a macro I wrote long ago which may be what you need, or adaptable to
your needs:

Sub SplitData()
'Extracts data for multiple entities (customers, brands, ??)
'from a master sheet to separate sheets for each entity.
'Assumptions in the code:
'1. ENTITY NAME/ID IS IN COLUMN A
'2. SHEET HAS HEADINGS IN ROW 1 ONLY
'3. THERE IS A HEADING FOR EVERY COLUMN WITH DATA
'4. DATA IS ALREADY SORTED BY COLUMN A
'5. MASTER DATA SHEET IS ACTIVE WHEN MACRO IS RUN
'----------------------------------------------------------
'To use this macro:
'A) Open this file.
'B) Open the Excel file with the data. Make sure the correct sheet is active.
'C) Run the SplitData macro.
'----------------------------------------------------------
'Declare variables.
Dim CellRef1 As Object, BaseSht As String
Dim a As Integer, x As Integer, MT As Integer
Dim CurrID As String, PrevID As String
Dim EndCol As Integer
'Store the name of the starting sheet
BaseSht$ = ActiveSheet.Name
Range("A2").Activate
a% = ActiveCell.Row
'Assign the first entity ID as PrevID (so have a value to compare).
PrevID$ = ActiveCell.Value
'Find the last data column (with a heading).
EndCol% = Cells(1, Columns.Count).End(xlToLeft).Column
MT% = 0
'Go to second row, first column. Walk down column A and test value of
'every cell. Stop when 100 consecutive empty cells are encountered.
Do While MT% < 100
Set CellRef1 = Cells(a%, 1)
CellRef1.Activate
CellRef1.Select
CurrID$ = CellRef1.Value
'If the current cell is empty, add 1 to MT, the empty cell counter.
If CurrID$ = "" Then
MT% = MT% + 1
Else
'If the current cell is not empty, reset MT. Check if its value
'(CurrID$) is the same as the previous row (PrevID$). If it's not
'the same, copy cols 1 through EndCol% for all the PrevID$ rows (including
'row 1). Paste them onto a new sheet, then return to the original sheet
'(BaseSht$). Delete all the PrevID$ rows (but not row 1). Assign the new
'CurrID$ to PrevID$. Reset a% to 1 (first row. Will then increment it).
MT% = 0
If CurrID$ < PrevID$ Then
Range(Cells(1, 1), Cells(a% - 1, EndCol%)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
ActiveSheet.Name = Cells(2, 1).Value
Sheets(BaseSht$).Activate
Range(Cells(2, 1), Cells(a% - 1, EndCol%)).Select
Selection.EntireRow.Delete
PrevID$ = CurrID$
a% = 1
End If
End If
a% = a% + 1
Loop
End Sub

Hope this helps,

Hutch

"anthonyberet" wrote:

I am looking for a way to have excel open and compile separate
worksheets for different values in column A, in a large list of data
(about 6000 lines worth).
There are about 10 possible values for column A, and I need a separate
worksheet for each value, with the rest of the data from that line in
that new worksheet.

Is there an automated way to do this? - At the moment I am reduced to
ordering the worksheet by column A and cutting and pasting the lines for
each section onto new worksheets.