Copy and Paste a Range of Cells to another sheet based on a Cellref and then delete the row

[Mattyastill]

[COLOR=#BBC0C4 !important][COLOR=#6A737C !important]I currently have multiple sheets for storing records of payments (things to be Pay and CantPay). I am trying to write a macro that will copy and paste Cells A:M on every row where column T = "Resolved" on the CantPay sheet (where the next empty row is the next row where "a" & row-number = blank) to the "Pay" sheet
[/COLOR]
[/COLOR]

Within the sheet which i want to copy from there is data in columns A:T but N:T are not needed once the problem is resolved. So once i have copy and pasted the data within cells A:M i want to just delete the entire row. I have written some code from what i knew and looking online which isn't working. Any help would be much appreciated.
Thanks


I have tried recording a macro and writing my own but it seems the macro i have wrote is deleting row 1 which is where all my column headers are stored.

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub MoveToPay()

Dim CantPay As Worksheet:Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet:Set PasteSheet = Sheets("£ Pay")
Dim lr AsLong
Dim S AsString


Application.ScreenUpdating =False

Columns(20).AutoFilter 1,"Resolved"
With Range("a2", Range("M"& Rows.Count).End(3))
.Copy PasteSheet.Cells(Rows.Count,1).End(3).Offset(1)
.EntireRow.Delete
EndWith
Columns(20).AutoFilter


Application.ScreenUpdating =True



EndSub</code>

 

[JLGWhiz]

See if this does it.

Sub MoveToPay()
Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("£ Pay")
Dim lr As Long
Dim S As String
Application.ScreenUpdating = False
Columns(20).AutoFilter 1, "Resolved"
With Range("a2", Range("M" & Rows.Count).End(3)).[COLOR=#b22222]SpecialCells(xlCellTypeVisible)
[/COLOR].Copy PasteSheet.Cells(Rows.Count, 1).End(3).Offset(1)
.EntireRow.Delete
EndWith
Columns(20).AutoFilter
Application.ScreenUpdating = True
EndSub

 

[Mattyastill]

Hi,

Thanks! This did work but when i changed the cell range which i want to copy and paste it seemed to happen again. I have changed it now to A2:N & Rows.count. I think the issue is when no cell in column T (20) = "Resolved" but i cant see to fix it. I have tried adding this additional code as the top but i think it may be incorrect, Would you be able to assist?

Sub MoveToPay()

Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("£ Pay")
Dim lr As Long
Dim S As String
Dim SearchRng As Range, Cell As Range

Application.ScreenUpdating = False


Set SearchRng = Range("T2", "T" & Rows.Count).End(3)
For Each Cell In SearchRng
    If Cell.Value = "Resolved" Then
Exit Sub

Else

Columns(20).AutoFilter 1, "Resolved"
With Range("a2", Range("M" & Rows.Count).End(3)).SpecialCells(xlCellTypeVisible)
    .Copy PasteSheet.Cells(Rows.Count, 1).End(3).Offset(1)
    .EntireRow.Delete
End With
Columns(20).AutoFilter

MsgBox "Resolved Payments have been transfered to Ready to Pay"

Application.ScreenUpdating = True

End If

Next Cell
End Sub

 

[Mattyastill]

UPDATE::

I have managed to get the macro to search Column 20 to see if "Resolved" is there but the macro is still deleting row 1 When column T2 contains "Resolved" and it should be copy and pasting that row.

Anyone have any ideas?

Sub MoveToPay()


Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("£ Pay")
Dim lr As Long
Dim S As String
Dim SearchRng As Range, Cell As Range




Application.ScreenUpdating = False




If Not IsError(Application.Match("Resolved", Range("T2:T250"), 0)) Then


    Columns(20).AutoFilter 1, "Resolved"
    With Range("a2", Range("M" & Rows.Count).End(3)).SpecialCells(xlCellTypeVisible)
        .Copy PasteSheet.Cells(Rows.Count, 1).End(1).Offset
        .EntireRow.Delete
    End With
    Columns(20).AutoFilter
    
    
    MsgBox "Resolved Invoices have been transfered to Ready to Pay"


Else


    MsgBox "No Invoices are marked as resolved"
    Exit Sub
    
End If
    


Application.ScreenUpdating = True


End Sub

 

[JLGWhiz]

This seemed to work OK.

Sub MoveToPay()
Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("£ Pay")
Dim lr As Long
Dim S As String
Dim SearchRng As Range, Cell As Range
Application.ScreenUpdating = False
If Not IsError(Application.Match("Resolved", Range("T2:T250"), 0)) Then
    Columns(20).AutoFilter 1, "Resolved"
    With Range("a2", Range("M" & Rows.Count).End(3)).SpecialCells(xlCellTypeVisible)
        .Copy PasteSheet.Cells(Rows.Count, 1).End(3).Offset(1)
        .EntireRow.Delete
    End With
    Columns(20).AutoFilter
    MsgBox "Resolved Invoices have been transfered to Ready to Pay"
Else
    MsgBox "No Invoices are marked as resolved"
    Exit Sub
End If
Application.ScreenUpdating = True
End Sub