Hey Mike, I loved your script. It's the shortest and easiest one I've found to accomplish this feat.

For Non VBA programmers (like me) I managed to decipher the code and added a few little features that I used on my worksheet. I described every step so the newbie can figure out exactly how it works and perhaps make the necessary adjustments to make it work for them. Here it is:


Sub copyit()

' This macro will move any and all rows from the current active Task Sheet to a
' Completed Items worksheet based on whether a specific cell in the row is not blank.
' For example, lets assume column N is where you would enter the date on which
' a task was completed. When you run this macro it will detect
' that there is data in that column and the entire row will be moved to the
' Completed Tasks worksheet. This macro looks specifically in column N but
' this can be modified to look at any column.

' The macro can also handle multiple Tasks sheet where completed items
' are to be moved to their associated Completed Items sheet or to a common
' Completed Items sheet. For this purpose I have set up a condition to
' examine three differnt task sheets "Tasks A", "Tasks B" and "Tasks C".
' Upon runing the macro, any completed items will be moved from the active
' Tasks sheet to its corresponding Completed Tasks sheet, A, B or C.
' It will not, however, do all of the sheets simultaneously. It will only
' work on the active Tasks sheet.

' FIRST, LETS CREATE A FEW VARIABLES.

' Sheet1 is a "String" variable to store the name of the active "Tasks" sheet at the
' time this macro was launched
Dim Sheet1 As String

' Sheet2 is a "String" variable to store the name of the "Completed Tasks" sheet that
' corresponds with Sheet1
Dim Sheet2 As String

' MyRange is a "Range" variable to store the range of rows to be examined in
' the current sheet.
Dim MyRange1 As Range

' MyRange1 is a "Range" variable to store the range of rows to be moved.
Dim MyRange As Range

' STEP 1: Store the name of the active Tasks sheet into variable Sheet1

Sheet1 = ActiveSheet.Name

' STEP 2: Based on which Tasks sheet is active we store the name of its corresonding
' Completed Tasks worksheet in variable Sheet2
If Sheet1 = "Tasks A" Then
Sheet2 = "Completed Tasks A"
ElseIf Sheet1 = "Tasks B" Then
Sheet2 = "Completed Tasks B"
ElseIf Sheet1 = "Tasks C" Then
Sheet2 = "Completed Tasks C"
Else
' If the macro was activated from any other sheet then we stop running the script
Exit Sub
End If

' STEP 2: Find the last populated row in Sheet1 based on there being data in column A
' If column A is not a constant in your Tasks sheet then select a column that will
' always have data in it such as the Task Name or Task Description column.
lastrow = Sheets(Sheet1).Cells(Rows.Count, "A").End(xlUp).Row

' STEP 3: Find all rows in Sheet1 in which column N contains data. The macro assumes
' that you are using column headers therefore it ignores row 1 and starts at row 2.
' Be sure that your Completed Tasks sheets already have the same headers set up.
Set MyRange = Sheets(Sheet1).Range("N2:N" & lastrow)
For Each c In MyRange
If c.Value < "" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next

' STEP 4: Move rows found in STEP 3 (if any) to the corresponding Completed Tasks sheet
If Not MyRange1 Is Nothing Then
MyRange1.Copy
Sheets(Sheet2).Select
lastrow = Sheets(Sheet2).Cells(Rows.Count, "A").End(xlUp).Row
Sheets(Sheet2).Range("A" & lastrow + 1).Select
ActiveSheet.Paste
' Now we delete the selected rows from Sheet1
' Note: If the sheet is protected this will cause an error and the macro will terminate
MyRange1.Delete
End If

' Finally we return to the worksheet from which this macro was Launched.
Sheets(Sheet1).Select

End Sub


Good Luck!





Mike wrote:

Hi,Put this in a general module. Alt+F11 to open VB editor.
23-May-08

Hi,

Put this in a general module. Alt+F11 to open VB editor. Right click 'This
workbook' and insert module and paste it in there and run it. It will search
column A on sheet1 for any valur <=0 and copy it to the first unused row of
column A in sheet2. WARNING it then deletes those rows from Sheet 1 so test
it on unimportant data

Sub copyit()
Dim MyRange, MyRange1 As Range
lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet1").Range("A1:A" & lastrow)
For Each c In MyRange
If c.Value < "" And c.Value <= 0 Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Copy
End If
Sheets("Sheet2").Select
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lastrow + 1).Select
ActiveSheet.Paste
MyRange1.Delete
End Sub

Mike

"DavidSchardien" wrote:

Previous Posts In This Thread:

On Friday, May 23, 2008 1:46 PM
DavidSchardien wrote:

Excel macro to copy row from one tab to another based on certain criteria
What I want to do would be two steps.

Step 1

If a value in a cell meets certain criteria (i.e. A1<0), copy the entire row
to the first unpopulated row in a separate tab.

Step 2

Delete the copied row from the original tab.

The main criteria I will be using is (but not limited to) A1<0, A1=0,
-30%<A1<70%

Thanks!

url:http://www.ureader.com/gp/1037-1.aspx

On Friday, May 23, 2008 2:35 PM
Mike wrote:

Hi,Put this in a general module. Alt+F11 to open VB editor.
Hi,

Put this in a general module. Alt+F11 to open VB editor. Right click 'This
workbook' and insert module and paste it in there and run it. It will search
column A on sheet1 for any valur <=0 and copy it to the first unused row of
column A in sheet2. WARNING it then deletes those rows from Sheet 1 so test
it on unimportant data

Sub copyit()
Dim MyRange, MyRange1 As Range
lastrow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
Set MyRange = Sheets("Sheet1").Range("A1:A" & lastrow)
For Each c In MyRange
If c.Value < "" And c.Value <= 0 Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Copy
End If
Sheets("Sheet2").Select
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Sheet2").Range("A" & lastrow + 1).Select
ActiveSheet.Paste
MyRange1.Delete
End Sub

Mike

"DavidSchardien" wrote:


Submitted via EggHeadCafe - Software Developer Portal of Choice
Measuring SharePoint Page Rendering
http://www.eggheadcafe.com/tutorials...oint-page.aspx