CODEWITHSUNDEEP
excelvba
Matthew Astill
Matthew Astill

Reputation: 1

VBA Macro is copy and pasting incorrect rows

I have created a macro which will autofilter a range of cells in column T for "Resolved". It will then copy and paste the filtered data to the next available row in another sheet.

When i run the macro, it seems to be copying and pasting row 1 where all my column headers are in.

Cell T2 Contains "Resolved" yet it is pasting the Range(A1:M1) into my other sheet.

Ive tried a variety of changes such as changing the Offset and End but nothing seems to work.

Sub MoveToPay()

Dim CantPay As Worksheet: Set CopySheet = Sheets("Can't Pay")
Dim ReadyToPay As Worksheet: Set PasteSheet = Sheets("iSeries £ 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

Any help would be much appreciated.

Upvotes: 0

Views: 174

Answers (1)

PonderingPanda
PonderingPanda

Reputation: 124

Try this : 

Sub MoveToPay()
    Dim CopySheet As Worksheet
    Set CopySheet = Sheets("Can't Pay")
    Dim PasteSheet As Worksheet
    Set PasteSheet = Sheets("iSeries £ Pay")
    Dim lastrow As Integer
    Dim lastrow2 As Integer

    lastrow = CopySheet.Range("M" & Rows.Count).End(xlUp).Row
    lastrow2 = PasteSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

    Application.ScreenUpdating = False

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

        ' copy Resolved data
        CopySheet.Range("A2:T" & lastrow).Select
        CopySheet.Range("A1:T" & lastrow).AutoFilter Field:=20, Criteria1:="Resolved"
        Selection.Copy

        ' paste it to other sheet
        PasteSheet.Range("A" & lastrow2).PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False

        ' remove Resolved data from CopySheet, offsetting to exclude headers
        With CopySheet.Range("A1:T" & lastrow)
          .AutoFilter Field:=20, Criteria1:="Resolved"
          .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With

        ' remove AutoFilter
        CopySheet.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

I have made some changes to the Dim

Upvotes: 0

Related Questions