Transfer Data from one sheet to 2 other sheets based on criteria gets stuck mid-sub

I have an excel workbook with three sheets named "PROSPECTS", "CLIENTS" and "NO GO" and I have been trying to write a vba sub which moves rows from the "Prospects" sheet to the "Clients" and "No Go" sheets based upon criteria in one column (which I have tagged status) and then delete the empty rows in the "Prospects" sheet. All three sheets have the same headers which occupy two rows.

Once it is all working, I would then add to the "Prospects" sheet on a daily basis and update the "Clients" and "No Go" sheets with a command button which calls my vba routine. I have created a vba sub to do this but it gets stuck half way through and I can not get it to work. Can anybody help please.

My command button sub is as follows:

Private Sub CommandButton1_Click()

a = Worksheets("PROSPECTS").Cells(Rows.Count, 1).End(xlUp).row

' Prevents screen refreshing.
Application.ScreenUpdating = False

For i = 3 To a

If Worksheets("PROSPECTS").Cells(i, 29).Value = "ON RISK" Then

Worksheets("PROSPECTS").Rows(i).Cut
Worksheets("CLIENTS").Activate
b = Worksheets("CLIENTS").Cells(Rows.Count, 1).End(xlUp).row
Worksheets("CLIENTS").Cells(b + 1, 1).Select
ActiveSheet.Paste
ActiveSheet.Columns(29).EntireColumn.Delete
Worksheets("PROSPECTS").Activate

ElseIf Worksheets("PROSPECTS").Cells(i, 29).Value = "DID NOT PROCEED" Then

Worksheets("PROSPECTS").Rows(i).Cut
Worksheets("NO GO").Activate
c = Worksheets("NO GO").Cells(Rows.Count, 1).End(xlUp).row

Worksheets("NO GO").Cells(c + 1, 1).Select
ActiveSheet.Paste [THIS IS WHERE THE ROUTINE STOPS]
ActiveSheet.Columns(29).EntireColumn.Delete
Worksheets("PROSPECTS").Activate

End If

Next i

Application.CutCopyMode = False
ThisWorkbook.Worksheets("PROSPECTS").Cells(1, 1).Select

Call delete_blank_rows

End Sub

The delete_blank_rows sub which is called for is in Module 1 and is as follows:

Sub delete_blank_rows()
Dim row As Long
LastRow = ThisWorkbook.Sheets("PROSPECTS").Cells(Rows.Count, 1).End(xlUp).row
row = 3
For row = LastRow To row Step -1
If Cells(row, 1) = "" Then
Cells(row, 1).EntireRow.Delete
End If
Next row
End Sub

In the “Prospects” sheet, the prospects become clients or no go at different speeds and so the criteria for moving though always in column 29 (column “AC”) can be mixed in different rows. I have indicated where the routine stops. It does transfer the rows marked as clients in column 29 but stops when it comes to one which is marked “ONGOING”. Since all “NO Go” rows and some of the “Clients” rows are below that point it does nothing to them.

I am stuck. I would be most grateful for assistance please.

Hello Mumps 1,

First of all thank you for your input. Unfortunately your macro did not work, it gave me a Run-time error 1004 with the
caption ‘cannot change part of a merged cell’ . The only merged cells in my model are in the headers which occupy rows 1 and 2
of each of the 3 sheets.

This may be because I did not explain clearly the object of the exercise.
In any event, my ‘Prospects’ sheet is the main input sheet and the data rows extend from row 3 to any number.
There are 29 columns of data. The 29th column (AC) is a status column. All entries start as Prospects and commence
with the status as ‘Ongoing’. At a certain point they are then designated as ‘Clients’ or No Gos and should with the
click of the Commandbutton, they should be transferred to their respective sheets. All new transfers to those two sheets
should append the new rows to the first empty rows in those sheets. Since the 29th status column is not needed in the Clients
and No Go sheets, it should be deleted on both the Clients and No Go sheets once the rows have been transferred.

Going back to the Prospects sheet, the resulting empty rows on the Prospects sheet should be deleted and only those
rows with the status in column 29 as ‘Ongoing’ should remain

In this way each of the sheets become ongoing and dynamic records of Prospects, Clients and No Gos respectively.

I hope that makes it more clear.

Thank you again for your input and I would really appreciate any additional help you can provide