MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Programatically copy a row to the next blank row of a worksheet


Posted by Greg on January 23, 2002 6:51 PM

Ok, this "Tip of the Week" came close to providing me what I needed, but I have to add a couple twists. Look at this link for an example of the code I am using.

http://www.mrexcel.com/tip044.shtml

Here are my twists:

1) I need to delete the entire row that was copied on "Sheet1".

2) I want the macro to automatically run as soon as I exit the cell after I type either "ir" or "RR".

Thanks for the help


Posted by Tom Urtis on January 23, 2002 9:11 PM

Right click on your Sheet1 tab, left click on View Code, and paste this in:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 10 And (Target.Row > 1 And Target.Row <= 100) Then
If Target.Value = "ir" Or Target.Value = "RR" Then
Target.Activate
Run "CutAndPaste"
End If
End If
End Sub

Then, in a standard module in the VBE, insert this macro:

Sub CutAndPaste()
Application.ScreenUpdating = False
Sheets("Sheet1").Range(ActiveCell, ActiveCell.Offset(, -9)).Cut _
Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
ActiveCell.EntireRow.Delete Shift:=xlUp
Application.ScreenUpdating = False
End Sub

This assumes you are working in Sheet1 within the range A2:J100, and that column J is where you are typing in "ir" or "RR". Modify as needed.

Tom Urtis

Posted by Tom Urtis on January 23, 2002 9:15 PM

One correction, the last line of the CutAndPaste macro should read
Application.ScreenUpdating = True

T.U.

Posted by Greg on January 24, 2002 5:10 PM

Part 1 didn't work

The macro results in an error:

Runtime Error '1004'
Application-defined or object-defined error

When I run the debugger, it highlites these 2 lines with the arrow pointing to the second line Sheets("Sheet1").Range(ActiveCell, ActiveCell.Offset(, -9)).Cut _

Thanks for all the help
Greg


Posted by Tom Urtis on January 24, 2002 6:55 PM

Re: Part 1 didn't work

Hmmm, strange, it worked perfectly when I tested it several times before posting here.

We could rewrite part of the code but first, just for fun, are you sure that your related sheet tab names are Sheet1 (the source "copy from" sheet) and Sheet2 (the destination "copy to" sheet)? The error you are seeing would be the case if your sheet tab names are different than the code, or if your copy range is not the same, i.e. not from column J, as this code cuts A:J from Sheet1.

Any of this help? We should start here first, at least for me to know that the code correctly reflects your sheet names and range.

Lemme know.

Tom Urtis


Posted by Greg on January 25, 2002 11:28 AM

Re: Part 1 didn't work

Appreciate all the help...here's a cut/paste from the code window: (Module 1 then Module 2)

Module 1

Public Sub CopyRows()
Sheets("open").Select
' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column I
ThisValue = Range("I" & x).Value
If ThisValue = "Y" Then
Range("A" & x & ":I" & x).Copy
Sheets("completed").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("open").Select
End If
Next x
End Sub

Module 2

Sub CutAndPaste()
Application.ScreenUpdating = False
Sheets("open").Range(ActiveCell, ActiveCell.Offset(, -9)).Cut _
Sheets("completed").Range("A65536").End(xlUp).Offset(1, 0)
ActiveCell.EntireRow.Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub

I've double-checked the names of the sheets and they match. I know I am missing something obvious, but I just can't see it.

Thanks again
Greg


Posted by Greg on January 25, 2002 11:30 AM

Re: Part 1 didn't work

Appreciate all the help...here's a cut/paste from the code window: (Module 1 then Module 2)

Module 1

Public Sub CopyRows()
Sheets("open").Select
' Find the last row of data
FinalRow = Range("A65536").End(xlUp).Row
' Loop through each row
For x = 2 To FinalRow
' Decide if to copy based on column I
ThisValue = Range("I" & x).Value
If ThisValue = "Y" Then
Range("A" & x & ":I" & x).Copy
Sheets("completed").Select
NextRow = Range("A65536").End(xlUp).Row + 1
Range("A" & NextRow).Select
ActiveSheet.Paste
Sheets("open").Select
End If
Next x
End Sub

Module 2

Sub CutAndPaste()
Application.ScreenUpdating = False
Sheets("open").Range(ActiveCell, ActiveCell.Offset(, -9)).Cut _
Sheets("completed").Range("A65536").End(xlUp).Offset(1, 0)
ActiveCell.EntireRow.Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub

I've double-checked the names of the sheets and they match. I know I am missing something obvious, but I just can't see it.

Thanks again
Greg


Posted by Tom Urtis on January 25, 2002 11:42 AM

Re: Part 1 didn't work

Well the curiosity bug has bitten me again, please send me the workbook so I can see why this would be happening to you when it does not happen to me. Maybe I'm missing something obvious too. Include any other narrative details as you'd like about what you are seeing, and we'll get this ork right.

TomUrtis@attbi.com

Thanks.

Tom U.

Appreciate all the help...here's a cut/paste from the code window: (Module 1 then Module 2) Module 1 Public Sub CopyRows()


Posted by Greg on January 27, 2002 7:23 AM

Re: Part 1 didn't work

That did the trick.

Thanks for all the help via email. I appreciate it.

Greg Well the curiosity bug has bitten me again, please send me the workbook so I can see why this would be happening to you when it does not happen to me. Maybe I'm missing something obvious too. Include any other narrative details as you'd like about what you are seeing, and we'll get this ork right. TomUrtis@attbi.com Thanks. Tom U.