Find, cut, and paste entire row
updated as requested:
Sub MoveData()
Dim myvalue As Range
Dim LastRow As Long
Dim nextsh As Worksheet
PPID = "Input ID"
Set nextsh = Worksheets("Sheet2") '<change as required
With ActiveSheet
Set myvalue = .Columns("H").Find(InputBox(PPID))
'cancel
If myvalue.Value = "" Then Exit Sub
If myvalue Is Nothing = False Then
'value entered found
myrow = myvalue.Row
LastRow = nextsh.Cells(Rows.Count, "H").End(xlUp).Row + 1
myvalue.EntireRow.Cut Destination:=nextsh.Range("A" & LastRow)
.Cells(myrow, 1).EntireRow.Delete
Else
MsgBox "ID Not Found"
End If
End With
End Sub
--
jb
"Jaybird" wrote:
How can I get this module to delete the blank row left over from the
cut and paste?
|