View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Jim Thomlinson[_4_] Jim Thomlinson[_4_] is offline
external usenet poster
 
Posts: 1,119
Default slecting data???

Sub MoveErrors()
Dim wksCurrent As Worksheet
Dim wksNew As Worksheet
Dim rngFirst As Range
Dim rngFound As Range
Dim rngAllFound As Range
Dim rngToSearch As Range
Dim strToFind As String

strToFind = "DRG"
Set wksCurrent = Sheets("Sheet1")
Set rngToSearch = wksCurrent.Columns("C")
Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole)
If rngFound Is Nothing Then
MsgBox "Sorry. Nothing to Move"
Else
Set wksNew = Worksheets.Add
Set rngFirst = rngFound
Set rngAllFound = rngFound.EntireRow
Do
Set rngAllFound = Union(rngAllFound, rngFound.EntireRow)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFirst.Address
rngAllFound.Copy
wksNew.Range("A2").PasteSpecial xlPasteValues
rngAllFound.Delete
wksCurrent.Cells.Copy
wksNew.Cells.PasteSpecial xlPasteFormats
wksCurrent.Rows(1).Copy wksNew.Range("A1")
Application.CutCopyMode = False
End If
End Sub

--
HTH...

Jim Thomlinson


"Lime" wrote:

Great that brought it over but not the header or the format. What if I want
to pull a string can I pull at once?

"Jim Thomlinson" wrote:

Give this a try...

Sub MoveErrors()
Dim wksCurrent As Worksheet
Dim wksNew As Worksheet
Dim rngFirst As Range
Dim rngFound As Range
Dim rngAllFound As Range
Dim rngToSearch As Range
Dim strToFind As String

strToFind = "DRG"
Set wksCurrent = Sheets("Sheet1")
Set rngToSearch = wksCurrent.Columns("C")
Set rngFound = rngToSearch.Find(What:=strToFind, LookAt:=xlWhole)
If rngFound Is Nothing Then
MsgBox "Sorry. Nothing to Move"
Else
Set wksNew = Worksheets.Add
Set rngFirst = rngFound
Set rngAllFound = rngFound.EntireRow
Do
Set rngAllFound = Union(rngAllFound, rngFound.EntireRow)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = rngFirst.Address
rngAllFound.Copy
wksNew.Range("A2").PasteSpecial xlPasteValues
rngAllFound.Delete
Application.CutCopyMode = False
End If
End Sub
--
HTH...

Jim Thomlinson


"Lime" wrote:

if I want to look for only certin data in a column say (Drg) and move the
whole row of data to a new sheet in the workbook an call it " Errors" does
anyone know how to approach?

Thanks,
Lime