Move Rows to another sheet (Excel 2003 SP2)

Topic

New Reply

I need to move rows of data from one sheet to another in the same workbook using VBA.
When the macro is fired it will look at the Status column (E) on the sheet named Active. If the first word in column E of any row is closed (not case sensitive), it should move that row (with formating intact) to the next empty row in the sheet named Closed, and delete the row from Active. I have various forms of protection and all are removed from the sample attached. The protection scheme works great and I have no trouble with that. I searched here and found a few posts about moving data but I was not able to modify any to work for me.

Anyone got the time?

Thanks,
Chuck

Reply | Quote

Replies

Try this:

Sub MoveClosedItems()
Dim wshActive As Worksheet
Dim wshClosed As Worksheet
Dim m As Long
Dim r As Long
Dim n As Long

Set wshActive = Worksheets(“Active”)
Set wshClosed = Worksheets(“Closed”)
‘ Last used source row
m = wshActive.Range(“A65536”).End(xlUp).Row
‘ Last used target row
n = wshClosed.Range(“A65536”).End(xlUp).Row
‘ Loop backwards through source rows
For r = m To 2 Step -1
‘ Test column E
If LCase(Left(wshActive.Range(“E” & r), 6)) = “closed” Then
‘ Next target row
n = n + 1
‘ Copy row
wshActive.Range(“A” & r).EntireRow.Copy _
Destination:=wshClosed.Range(“A” & n)
‘ Then delete it
wshActive.Range(“A” & r).EntireRow.Delete
End If
Next r

‘ Clean up
Set wshClosed = Nothing
Set wshActive = Nothing
End Sub

Reply | Quote

Hans/Jerry,

Thanks so much!
Hans, your code works great (no surprize there).
Jerry, I have not tried your code yet but am intrigued by your use of MsgBox in the line:MsgBox Cells(r, 5).Value.
I will be playing around with this.
Thanks so much for the help.
It is nice to know there is a place to turn, when brick walls are encountered.

Ever greatful,
Chuck

Reply | Quote

Hi Chuck

Sorry I edited the post as I realised I had left it in the original code that you recieved via email. I placed it in my code as an error checker when I was stepping (F8ing) through the code. I have removed it from the code in the thread now.Sorry for the confusion

Reply | Quote

Jerry,

DANG! Here I thought I was going to learn a neat new trick!
Thanks and Have a Great day.

Chuck

Reply | Quote

(Edited by Jezza on 25-Jul-06 14:04. To get rid of a silly msgbox error trap thing I had in the code)

Chuck

I have done it slightly differently to Hans using two subs, but gives the same result. I have got to rush off to a meeting now so you will have to adjust it to fit in with the upper case and title case aspect.

Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lastrow As Long, r As Long

lastrow = ActiveSheet.UsedRange.Rows.Count

For r = lastrow To 1 Step -1

If Left(Cells(r, 5).Value, 6) = “Closed” Then
Rows®.Copy
pasteMe
Rows®.Delete
End If

Next r

ActiveWorkbook.Save

End Sub

Sub pasteMe()
Dim newlastrow As Long

Sheets(“Closed”).Activate
newlastrow = ActiveSheet.UsedRange.Rows.Count
Cells(newlastrow + 1, 1).Select
ActiveSheet.Paste
Sheets(“Active”).Activate

End Sub

Reply | Quote