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

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

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

T.U.

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

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

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

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

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()

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.