VB to move entire row to another sheet
 

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.

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.WorksheetF unction.CountA(Sheets("CHHP").Range("A:A")))
Set CPH = Sheets("CPH").Range.Offset(Application.WorksheetFu nction.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" And 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....

VB to move entire row to another sheet
 

On Tuesday, March 6, 2012 9:11:16 PM UTC-6, nojeel wrote:
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








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.WorksheetF unction.CountA(Sheets("CHHP").Range("A:A")))
Set CPH =
Sheets("CPH").Range.Offset(Application.WorksheetFu nction.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" And
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....




--
nojeel