Sub Extract()
Dim rng As Range, cell As Range
With Worksheets("Sheet1")
Set rng = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cell In rng
If cell.Font.Size = 14 Then
cell.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(cell.Row, 1)
End If
Next
Set rng = Worksheets("Sheet1").Cells.find("Stuff", _
LookIn:=xlValues, LookAt:=xlPart)
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.EntireRow.Copy Destination:= _
Worksheets("Sheet2").Cells(rng.Row, 1)

Set rng = Worksheets("Sheet1") _
cells.FindNext(rng)
Loop Until rng.Address = sAddr
End If
End Sub

--
Regards,
Tom Ogilvy


"Karlos" <Karlos.1yakka_1131644103.9455@excelforum-nospam.com> wrote in
message news:Karlos.1yakka_1131644103.9455@excelforum-nospam.com...
>
> Hi, Ive had to start a new thread, I can't find my last one with the
> same question which may well have been answered - appologies and thanks
> if it has.
>
> below is macro that Tom provided which was a great help and again
> thanks, (Tom)
>
> The problem is that it wont go pass one loop and comes back with run
> time error 91.
>
> This only happens if the "search" criteria is matched, if I,m looking
> for "stuff" and ithe text "stuff" is in the spreadsheet I get the error
> 91 and it halts. If "stuff" is not in the spreadsheet, no error is
> reported.
>
> I also looking for the best way of deleting the rows in the new sheet,
> would a seperate macro be best in sheet2 or could it be combined?
>
> Sub Extract()
> Dim rng As Range, cell As Range
> With Worksheets("Sheet1")
> Set rng = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
> End With
> For Each cell In rng
> If cell.Font.Size = 14 Then
> cell.EntireRow.Copy Destination:= _
> Worksheets("Sheet2").Cells(cell.Row, 1)
> End If
> Next
> Set rng = Worksheets("Sheet1").Cells.find("Stuff", _
> LookIn:=xlValues, LookAt:=xlPart)
> If Not rng Is Nothing Then
> sAddr = rng.Address
> Do
> rng.EntireRow.Copy Destination:= _
> Worksheets("Sheet2").Cells(rng.Row, 1)
> Set rng = cell.FindNext(rng)
> Loop Until rng.Address = sAddr
> End If
> End Sub
>
>
> --
> Karlos
> ------------------------------------------------------------------------
> Karlos's Profile:
http://www.excelforum.com/member.php...o&userid=28649
> View this thread: http://www.excelforum.com/showthread...hreadid=484004
>