VB to move entire row to another sheet

[nojeel]

Hello, I am working on a spreadsheet and I'd like to move an entire ro
(cut and paste) based on values of columns A and W. Essentially, wha
I'd like to do is whenever column W conatins a date greater ta
01/01/2001, move the entire row to a sheet which name is equal to colum
A (location).

Below is a code that I believe is working HOWEVER the row is not paste
on to the next available row of the destination sheet. It is bein
pasted on the same row as the original row in.

Sub CompletedItems()
Dim TARAppvd As Range, Site As Range, CHHP As Range, CPH As Range
Dim i, j As Integer

i = 1: j = 1
Set TARAppvd = Sheets("2012 Log").Range("W2")
Set Site = Sheets("2012 Log").Range("A2")
Set CHHP
Sheets("CHHP").Range.Offset(Application.WorksheetFunction.CountA(Sheets("CHHP").Range("A:A")))
Set CPH
Sheets("CPH").Range.Offset(Application.WorksheetFunction.CountA(Sheets("CPH").Range("A:A")))

Do While Site.Offset(i, 0).Value <> ""
If TARAppvd.Offset(i, 0).Value > "01/01/2001" And Site.Offset(i
0).Value = "CHHP" Then
TARAppvd.Offset(i, 0).EntireRow.Copy
Sheets("CHHP").Activate
CHHP.Offset(j, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Sheets("2012 Log").Activate
TARAppvd.Offset(i, 0).EntireRow.Delete xlShiftUp
j = j + 1
i = i - 1
ElseIf TARAppvd.Offset(i, 0).Value > "01/01/2001" An
Site.Offset(i, 0).Value = "CPH" Then
TARAppvd.Offset(i, 0).EntireRow.Copy
Sheets("CPH").Activate
CPH.Offset(j, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Sheets("2012 Log").Activate
TARAppvd.Offset(i, 0).EntireRow.Delete xlShiftUp
j = j + 1
i = i - 1
End If
i = i + 1
Loop
Application.CutCopyMode = False
End Sub

Any help is greatly appreciated!

Thanks...

 

[Don Guillett]

Hello, I am working on a spreadsheet and I'd like to move an entire row
(cut and paste) based on values of columns A and W. Essentially, what
I'd like to do is whenever column W conatins a date greater tan
01/01/2001, move the entire row to a sheet which name is equal to column
A (location).

Below is a code that I believe is working HOWEVER the row is not pasted
on to the next available row of the destination sheet. It is being
pasted on the same row as the original row in.

Your code is overly complicated. Instead of going thru it and changing, why not just modify this to suit your need. Filter and copy ..... If you need more help send your file to dguillett1 @gmail.com with a complete explanation and this msg.

Sub filterandcopyusedrange()
Dim ds As Worksheet
Set ds = Sheets("Sheet10")
Cells.Find("*", Cells(Rows.Count, Columns.Count) _
, , , xlByRows, xlPrevious).Copy ds.Range("d1")
With ActiveSheet.UsedRange
.AutoFilter Field:=6, Criteria1:="bob"
.SpecialCells(xlCellTypeVisible).Copy ds.Range("a2")
.AutoFilter
End With
End Sub