Using a cell reference to copy rows to a new worksheet

[wham]

Hi there - was a bit tongue tied with the thread title so I hope i
adequately describes my problem.

I've been tasked with redoing a revenue report at work, and in my hea
I've conjured up what could potentially be a huge time saving way o
doing things in the future, although have searched help files an
looked around online and can't find the formula/macro (if it exists) t
enable me to do this.


The problem is this:

Sheet 1 of the workbook is a large input sheet. Every row contained i
that sheet will, in column A, be titled 'red', 'yellow' or 'green'
Columns B onwards contain other data which (at the moment) i
irrelevant to the problem.

Now what I want excel to do after I've put the raw data into the inpu
sheet (sheet 1), is to read the text in column A for each row, the
automatically copy ALL data in that row over to the next empty row o
another worksheet.

ie Sheet 2 will have all rows that have 'Red' in column A on the inpu
sheet, Sheet 3 will have all those titled 'Yellow' and Sheet 4 wil
have all those titled 'Red'.

Is this something that is possible?

I know I can use a filter on the input sheet to just show the data
want, but each colour coded row will contain different data to another
and if there is a formula/macro setup i can use to do the above, then
can set the subsequent worksheets up to hide the superflous column
from the input sheet.

Hope that makes sense, and hope one of you guys is able to help.

Thanks

Wayn

 

[Guest]

Here's a play which automates it using non-array formulas ..

A sample construct is available at:
http://www.savefile.com/files/9260836
AutoCopy_Data_To_Resp_Sheet_Non_Array_Approach.xls

In sheet: WS1 (the "master")

Assume data in cols A to D, data in row2 down,
with the key col = col A (colours)

List the colours across in K1:M1, viz.: red, yellow, green

Put in K2: =IF($A2=K$1,ROW(),"")
Copy across to M2, fill down to say, M20
to cover the max expected extent of data

Click Insert > Name > Define
Put under "Names in workbook:": WSN
Put in the "Refers to:" box:
=MID(CELL("Filename",INDIRECT("A1")),FIND("]",CELL("Filename",INDIRECT("A1")
))+1,32)
Click OK

The above defines WSN as a name we can use to refer to the sheetname in
formulas. It will auto-extract the sheetname implicitly. Technique came from
a post by Harlan.

In a new sheet named: Red
With the same col headers pasted into A11

Put in A2:
=IF(ISERROR(SMALL(OFFSET(WS1!$J:$J,,MATCH(WSN,WS1!$K$1:$M$1,0)),ROWS($A$1:A1))),"",INDEX(WS1!A:A,MATCH(SMALL(OFFSET(WS1!$J:$J,,MATCH(WSN,WS1!$K$1:$M$1,0)),ROWS($A$1:A1)),OFFSET(WS1!$J:$J,,MATCH(WSN,WS1!$K$1:$M$1,0)),0)))

Copy A2 across to D2, fill down to say, D10
[copy down by the smallest possible range sufficient to cover the max
expected extent for any category. Here, I've assumed that 9 rows (rows 2 to
10) is sufficient]

Cols A to D will return only the lines for colour: Red from "WS1",
with all lines neatly bunched at the top

Now, just make a copy of the sheet: Red, rename it as: Green, and we'd get
the results for the colour: Green. Repeat the copy > rename sheet process to
get the rest of the colour sheets (a one-time job). Adapt to suit ..

---

 

[Leith Ross]

Hello Wayne,

Here is a VBA macro version. To use it , add a VBA Module to you
project code. You can then run it by selecting it the Macro Dialog Box
To display the available macros in Excel press ALT + F8.

Code
-------------------

Public Sub SplitAndCopyRows()

Dim Cell As Range
Dim I As Long
Dim LastRow As Long
Dim NextRow(3) As Long
Dim MainWks As Worksheet
Dim Wks As Worksheet

Set MainWks = Worksheets("Sheet1")
LastRow = MainWks.Range("A" & MainWks.Rows.Count).Row

With Worksheets("Sheet2")
NextRow(1) = .Range("A" & .Rows.Count).End(xlUp).Row
End With

With Worksheets("Sheet3")
NextRow(2) = .Range("A" & .Rows.Count).End(xlUp).Row
End With

With Worksheets("Sheet4")
NextRow(3) = .Range("A" & .Rows.Count).End(xlUp).Row
End With

For Each Cell In MainWks.Range("A1:A" & LastRow)
Select Case LCase(Cell.Value)
Case Is = "red"
Set Wks = Worksheets("Sheet2")
I = 1
GoSub CopyToNextRow
Case Is = "yellow"
Set Wks = Worksheets("Sheet3")
I = 2
GoSub CopyToNextRow
Case Is = "green"
Set Wks = Worksheets("Sheet4")
I = 3
GoSub CopyToNextRow
End Select
Next Cell

Exit Sub

CopyToNextRow:
If NextRow(I) <> 1 Or (NextRow(I) = 1 And Wks.Cells(1, 1).Value <> "") Then
NextRow(I) = NextRow(I) + 1
End If
MainWks.Range(Cell.Address).EntireRow.Copy Destination:=Wks.Range("A" & NextRow(I)).EntireRow
Return

End Su