Cutting and Pasting Cells

Hi Everyone,

I am looking to do the following.
1) Find a cell called 'test' in sheet2 of my workbook.
2) Cut the value in the cell to the right of the 'test' cell
3 Find a cell called 'test' in sheet1
4) Finally, paste the value found in step2 to the cell to the right of the cell found in step3.

My code is below, any help will be much appreciated!

Kind Regards

Ross





Option Explicit
Sub Arrange_Cells()
Dim sourcecell As Range
DIM sourcecell2 As Range
Dim sourcecell3 As Range
Dim destinationcell As Range
Dim destinationcell2 As Range
Dim sourcerange As Range
Dim matchrow As Integer
Dim matchrow2 As Integer

'Find Cell to Cut

Set sourcecell = Cells.Find(What:="Test*", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

Set sourcerange = sourcecell.Offset(0, 2) 'Selects cell in same Row, 2 Columns RIGHT
sourcerange.Cut

'Find Destination Cell

Set destinationcell = Cells.Find(What:="Test*", After:=Worksheets(1).Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

Set destinationcell2 = destinationcell.Offset(0, 2)

Set sourcecell3 = sourcecell2
sourcecell3.Paste Destination:=Worksheets(1).Range(destinationcell2)

Set sourcecell = Nothing
End Sub