ExcelBanter - Spreadsheet Programming

Here is a program for finding words (This & That) and copying the entire row
and pasting the results in another sheet. You just need to change the set
statements to suit your needs.

Sub Test()
Call CopyCells("This")
Call CopyCells("That")
End Sub

Sub CopyCells(ByVal strWordToFind As String)
Dim rngFirst As Range
Dim rngCurrent As Range
Dim rngFoundCells As Range
Dim rngToSearch As Range
Dim wksToSearch As Worksheet
Dim wksToPaste As Worksheet
Dim rngToPaste As Range

Set wksToSearch = Sheets("Sheet1")
Set wksToPaste = Sheets("Sheet2")
Set rngToSearch = wksToSearch.Cells
Set rngToPaste = wksToPaste.Range("A65536").End(xlUp).Offset(1, 0)
Set rngCurrent = rngToSearch.Find(strWordToFind)
If rngCurrent Is Nothing Then
MsgBox strWordToFind & " was not found"
Else
Set rngFirst = rngCurrent
Set rngFoundCells = rngCurrent.EntireRow
Do
Set rngFoundCells = Union(rngCurrent.EntireRow, rngFoundCells)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngFirst.Address = rngCurrent.Address
rngFoundCells.Copy rngToPaste
End If
End Sub

--
HTH...

Jim Thomlinson

"Paul" wrote:

Is there a program/ code I can use which will cut cells with a particular
value (text and/or number) and paste them to their particular worksheet, in
the same workbook? Also can I use this program to cut and paste the cells
adjacent to the selected cells in the same row i.e. move the whole row
beginning with this cell to a particular worksheet??