Move entire row to worksheet based on what is typed in NEED HELP THANK YOU!

[damancurry]

I am trying to move a whole row(B thru K of the row) to a different sheet when in column (B) on worksheet named Promises, you put either; PAID which would move the row to worksheet named Kept; BROKEN to worksheet named Broken; FOLLOW UP to worksheet named Followup.
On the next blank line in those worksheets either Paid, Broken or Followup. And if possible delete the moved line?

I need help I'm new at this and know Macros and don't know if that is the solution or <acronym title="vBulletin">VB</acronym>?

Here is my spreadsheet lay out below. THANK YOU.

A1	B	C	D	E	F	G	H	I	J	K
A2		DB #	DB Name	PRM Amount	Fee	Due By	Confidence	KEPT	Broken	Follow Up
A3	PAID	28603	Hamilton Scientific	$1,500.00	375.00	8/26/2014	1	x
A4	BROKEN	28603	Hamilton Scientific	$1,500.00	375.00	8/26/2014	2		x
A5	FOLLOW UP	28603	Hamilton Scientific	$1,500.00	375.00	8/26/2014	3			x

<tbody>
</tbody>

This doesn't work it please help:

Option Compare Text
Sub MM1()
Dim lr As Long, r As Long, lr2 As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
For r = lr To 2 Step -1
Select Case Range("B" & r).Value
Case Is = "PAID"
lr2 = Sheets("Kept").Cells(Rows.Count, "A").End(xlUp).Row
Rows(r).Copy Destination:=Sheets("Kept").Range("A" & lr2 + 1)
Case Is = "BROKEN"
lr2 = Sheets("Broken").Cells(Rows.Count, "A").End(xlUp).Row
Rows(r).Copy Destination:=Sheets("Broken").Range("A" & lr2 + 1)
Case Is = "FOLLOW UP"
lr2 = Sheets("Followup").Cells(Rows.Count, "A").End(xlUp).Row
Rows(r).Copy Destination:=Sheets("Followup").Range("A" & lr2 + 1)
End Select
Rows(r).Delete
Next r
End Sub



I uploaded to google drive account
https://drive.google.com/file/d/0B7cMUJJSgee1QmE3QU00M05vLW8/view?usp=sharing

 

[mumps]

Try:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    For x = LastRow To 2 Step -1
        Select Case Cells(x, 2)
            Case "PAID"
                Range("B" & x & ":K" & x).Copy Sheets("Kept").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Rows(x).EntireRow.Delete
            Case "BROKEN"
                Range("B" & x & ":K" & x).Copy Sheets("Broken").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Rows(x).EntireRow.Delete
            Case "FOLLOW UP"
                Range("B" & x & ":K" & x).Copy Sheets("Followup").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                Rows(x).EntireRow.Delete
        End Select
    Next x
    Application.ScreenUpdating = True
End Sub

 

[damancurry]

I still can't get this to work I have been on it for 2 days.

 

[mumps]

Wen I tried it with the data you posted, it worked properly for me. Can you upload a copy of your file to a free site such as www.box.com or to Dropbox? Mark the file for sharing and you'll be given a link to the file that you can post here.