Quote Originally Posted by JBeaucaire View Post
Try this on for size:

Option Explicit

Sub TransferRows()
'JBeaucaire (7/13/2009)
Dim LR As Long, LC As Long, NR As Long, i As Long
    
    If Not ActiveSheet.Name Like "Q*" Then
        MsgBox "Please activate select correct data sheet before running macro."
        Exit Sub
    End If

LR = Range("A" & Rows.Count).End(xlUp).Row

    For i = LR To 4 Step -1
        Select Case LCase(Cells(i, "P"))
            Case "won"
                If Cells(i, "P").Interior.ColorIndex = 10 Then
                    NR = Sheets("Won").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Rows(i).Copy Sheets("Won").Range("A" & NR)
                    Rows(i).Delete (xlShiftUp)
                End If
            Case "lost", "superseded"
                If Cells(i, "P").Interior.ColorIndex = 3 Then
                    NR = Sheets("Lost").Range("A" & Rows.Count).End(xlUp).Row + 1
                    Rows(i).Copy Sheets("Lost").Range("A" & NR)
                    Rows(i).Delete (xlShiftUp)
                End If
        End Select
    Next i
End Sub
Also, for some reason you had separate LISTS active in each column of your Q1 sheet, and that should really be just ONE big list so the same # of rows is active all the time, yes? Here's the data back with one LIST instead of 15.

Also, changed the Rolling Total formula to simply sum the whole column.
===========

How to add the macro to your sheet:

1. Open up your workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save your sheet

The macro is installed and ready to use. Press Alt-F8 and select it from the macro list.
Thank you very much for your help - I hav a couple of other small tweaks - can you help again please?