Cut and paste to new worksheet based on filter

Hi all

I need to cut an entire row and paste into another workbook (named "Bonus trans cut") based on two criteria in the original workbook (named GL import). The criteria is in (column A and is based on nominal codes "50019" and "52019".)

I then want to delete the whole rows and leave the filters on in GL import as it's a working sheet.

I've got the following so far but it seems to be falling over and whatever I do it just won't work!


Sub Bonus_Trans_Click()
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, rng As Range
Set sh1 = Sheets("GL Import")
lr = sh1.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
Set sh2 = Sheets("Bonus trans cut")
Set rng = sh1.Range("A1:AO" & lr)
rng.AutoFilter Field:=1, Criteria1:="50019", Operator:=xlOr, Criteria2:="52019"
rng.Offset(1, 1).Resize(rng.Rows.Count - 1, 41).SpecialCells(xlCellTypeVisible).Copy sh2.Cells(Rows.Count, 1)
rng.Offset(1, 1).Resize(rng.Rows.Count - 1, 41).SpecialCells(xlCellTypeVisible).EntireRow.Delete
sh1.AutoFilterMode = True
End Sub

Thank you!

Originally Posted by AlphaFrog

Try this.

Before running this code, check the very last row at the bottom of your Bonus trans cut sheet. It may have values in it as your old code was writing to the last row on the sheet.

Please Login or Register  to view this content.

Spot on! Thank you!