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.

[TABLE="class: cms_table"]
<tbody>[TR]
[TD]A1[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[/TR]
[TR]
[TD]A2[/TD]
[TD][/TD]
[TD]DB #[/TD]
[TD]DB Name[/TD]
[TD]PRM Amount[/TD]
[TD]Fee[/TD]
[TD]Due By[/TD]
[TD]Confidence[/TD]
[TD]KEPT[/TD]
[TD]Broken[/TD]
[TD]Follow Up[/TD]
[/TR]
[TR]
[TD]A3[/TD]
[TD]PAID[/TD]
[TD]28603[/TD]
[TD]Hamilton Scientific[/TD]
[TD]$1,500.00[/TD]
[TD]375.00[/TD]
[TD]8/26/2014[/TD]
[TD]1[/TD]
[TD]x[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A4[/TD]
[TD]BROKEN[/TD]
[TD]28603[/TD]
[TD]Hamilton Scientific[/TD]
[TD]$1,500.00[/TD]
[TD]375.00[/TD]
[TD]8/26/2014[/TD]
[TD]2[/TD]
[TD][/TD]
[TD]x[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]A5[/TD]
[TD]FOLLOW UP[/TD]
[TD]28603[/TD]
[TD]Hamilton Scientific[/TD]
[TD]$1,500.00[/TD]
[TD]375.00[/TD]
[TD]8/26/2014[/TD]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD]x[/TD]
[/TR]
</tbody>[/TABLE]

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.