Help with Cut-Delete-Paste to other sheet

[Jim]

Hi Everyone,
My program cycles through the rows on "Sheet1" and searches for contents in
col 9 that match a preset string. Once it finds a match it passes the string
contents to the function CutCopyRowsStr( ). I need to know how to cut an
entire row in "Sheet1", Delete that now empty row in "Sheet1" then paste the
contents into "Archive" (which is also a sheet in the same WorkBook). The
paste operation is in a loop so I also need to paste to row 1, 2, 3 etc as I
activate the "Archive" sheet. I am getting some "selection error". This is
what I have so far. Any help would be great, thanks.
=====================================================
Public rwcount As Integer 'Set = 1 In Workbook_Open

'del1 & del2 are strings passed to the function
Public Function CutCopyRowsStr(del1 As String, del2 As String)
Dim i As Integer

For i = 1 To Sheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row

If InStr(1, Cells(i, 9).Value, del1) > 0 Then
Sheets("Sheet1").Cells((i), 1).EntireRow.Cut
Sheets("Sheet1").Cells((i), 1).EntireRow.Select
Selection.Delete
ThisWorkbook.Sheets("Archive").Activate
ActiveSheet.Cells(rwcount, 1).EntireRow.Select
ActiveSheet.Paste
rwcount = rwcount + 1
End If

If InStr(1, Cells(i, 9).Value, del2) > 0 Then
Cells(i, 1).EntireRow.Cut
Cells((i), 1).EntireRow.Select
Selection.Delete
ThisWorkbook.Sheets("Archive").Activate
ActiveSheet.Cells(rwcount, 1).EntireRow.Select
ActiveSheet.Paste
rwcount = rwcount + 1
End If

Next i
ThisWorkbook.Sheets("Sheet1").Activate

End Function

 

[Dick Kusleika]

Hi Everyone,
My program cycles through the rows on "Sheet1" and searches for contents in
col 9 that match a preset string. Once it finds a match it passes the string
contents to the function CutCopyRowsStr( ). I need to know how to cut an
entire row in "Sheet1", Delete that now empty row in "Sheet1" then paste the
contents into "Archive" (which is also a sheet in the same WorkBook). The
paste operation is in a loop so I also need to paste to row 1, 2, 3 etc as I
activate the "Archive" sheet. I am getting some "selection error". This is
what I have so far. Any help would be great, thanks.

Public Function CutCopyRowsStr(del1 As String, del2 As String)
Dim i As Long
Dim sh As Worksheet
Dim shArch As Worksheet

Set sh = ThisWorkbook.Sheets("Sheet1")
Set shArch = ThisWorkbook.Sheets("Archive")

For i = sh.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1

If InStr(1, sh.Cells(i, 9).Value, del1) > 0 Or _
InStr(1, sh.Cells(i, 9).Value, del2) > 0 Then

With sh.Cells((i), 1).EntireRow
.Copy shArch.Range("A65536").End(xlUp).Offset(1)
.Delete
End With
End If
Next i

End Function

You have to loop through in reverse if you want to delete rows. This will
put them in Archive in reverse order though.