Copy and paste to last row of a different sheet ignoring filters on target sheet

[MNik]

I have a shared file and I am trying to create a macro that will copy a row and paste it to the last row in a different sheet. The issues that I am having is that sometimes the target sheet will have filters applied by other teammates. Is there a way to code the macro to ignore the filters and paste into the last row without having to remove the filters? Here the macro that I currently have.

Sub OpenOrders_InTransit()

'
'Move row from Open Orders to In Transit
'

Dim RL As Long, CL As Integer
    RL = ActiveCell.Row
    CL = ActiveCell.Column

Application.ScreenUpdating = False

    ActiveCell.Select
        Selection.EntireRow.Select
        Selection.Cut
        Sheets("In Transit").Select
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        ActiveSheet.Paste
        ActiveCell.Offset(0, 4).Range("A1").Select
        Selection.Delete Shift:=xlToLeft
        ActiveCell.Offset(0, 14).Range("A1").Select
        Selection.Delete Shift:=xlToLeft
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
        Sheets("Open Orders").Select
'
' RemoveEmptyRows Macro
'

'
    Columns("A:A").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
               
  
    Application.ScreenUpdating = True

'
'Return to previous cell
'
    Cells(RL, CL).Select


End Sub

Thanks in advance!

 

[OaklandJim]

I did not test with filtering but the code in THIS WORKBOOK should do what you need. Also, often there is no need to select everything. Hopefully this gets you started. FYI normally others on the list improve my code, sometimes a lot.

Sub OpenOrders_InTransit_New()

'   Count of occupied rows in target worksheet (named "In Transit")
    Dim iRowsCount As Long
    
'   Count occupied rows in column A of worksheet named In Transit.
'   Need to place cut values into the next available (empty) row.
    iRowsCount = Worksheets("In Transit").Cells(100000, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    If ActiveCell.Value Like "Data*" _
     Then
        MsgBox "Cannot move header cells! " & ActiveCell.Address & " was selected."
        Exit Sub
    End If
    
    If ActiveCell.Value = "" _
     Then
        MsgBox "There is nothing in cell " & ActiveCell.Address
        Exit Sub
    End If
    
'   Cut the row in source worksheet (Open Orders) and paste into "next" empty
'   cell in column A in target worksheet (named "In Transit").
    ActiveCell.EntireRow.Cut Worksheets("In Transit").Cells(1, 1).Offset(iRowsCount)
    
    With Worksheets("In Transit").Range("A1").Offset(iRowsCount)

'       Delete cell in column 15 in newly pasted data row.
       .Cells(1, 15).Delete Shift:=xlToLeft

'       Delete cell in column 5 in newly pasted data row.
       .Cells(1, 5).Delete Shift:=xlToLeft

    End With
    
    Worksheets("Open Orders").Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

 

[MNik]

This seems to be much more efficiently written and runs much better than what I currently have. I did test it with filters applied on the target sheet and it writes to the next line numerically which unfortunately overwrites any data in that line.

 

[OaklandJim]

Without your workbook I'm not sure what the issue is and I do not understand what you mean by "writes to the next line numerically."

Try changing

ActiveCell.EntireRow.Cut Worksheets("In Transit").Cells(1, 1).Offset(iRowsCount)

to

ActiveCell.EntireRow.Cut Worksheets("In Transit").Cells(1, 1).Offset(iRowsCount+1)

 

[OaklandJim]

You might also try clearing the filter before pasting next row

  If ActiveSheet.AutoFilterMode Then
     ActiveSheet.AutoFilterMode = False
  End If

 

[MNik]

I was able to get it to work using ActiveSheet.AutoFilter.ShowAllData. Thanks again for your help!