Contact me privately for custom work.
--
Don Guillett
SalesAid Software

"Don Guillett" wrote in message
...
Sub copiedfiltereddata()
mr = Sheets("sheet23").Columns(1).Find("Avon").Row
With Range("a2:a7")
.AutoFilter Field:=1, Criteria1:="favo"
mc = .SpecialCells(xlVisible).Count
Sheets("sheet23").Rows(mr + 1 & ":" & mr + mc).Insert
.SpecialCells(xlVisible).Copy _
Sheets("sheet23").Cells(mr + 1, 1)
.AutoFilter
End With
End Sub

--
Don Guillett
SalesAid Software

"Don Guillett" wrote in message
...
maybe autofilter the sourcecopy all of the visible cells at once to the
destination sheet where you FIND avon and insert the rows

--
Don Guillett
SalesAid Software

wrote in message
ups.com...
Hi all,

Can anybody please help, i have the code below (donated - many thanks)
but, i cannot get it to work.

Heres how i am set up...

in Sheet 'All'

Col A Col B.... Col n
Favo False 01/01/2006
Favo True 01/02/2006
Fsom False 01/03/2006
Favo False 01/04/2006

Note: there can be lots of 'Favo's' here.

In Sheet 'Section 2'

Col A

Avon - this can be on any row, but is always in Col A


What i want to do is Find all those rows on Sheet 'all' that have Favo
in Col A (and have Col B = False) copied into 'Section 2'. That is Find
'Avon' in 'Section 2' and paste the copied rows below it.

Sounds simple eh?

I have the code to copy it to a specific cell i.e. Section 2. Cell A51,
but, i cant get the Find, then copy bit to work!!!


The code so far....

Sub CopyAlltoSection2_FAVO()
Application.ScreenUpdating = False
Dim RngColA As Range

Dim I As Range
Dim sAdd As String
Dim Dest As Range
With Sheets("Section 2")
Set RngColA = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Cells
End With
For Each I In RngColA
If I.Value = "Favo" Then
I.Offset(2, 0).Insert shift:=xlDown
Set Dest = I.Offset(2, 0)
Exit For
End If
Next I

Sheets("all").Select
Set RngColA = Sheets("all").Range("A1", Sheets("all").Range("A" &
Rows.Count).End(xlUp))
For Each I In RngColA
If I.Value = "Avon" Then
I.Resize(, 11).Copy Dest
Dest.Offset(1, 0).Insert shift:=xlDown
Set Dest = Dest.Offset(1, 0)
End If
Next I

Application.ScreenUpdating = True
End Sub


My original code is... any use?

Sub CopyAlltoSection2_FAVO()
Application.ScreenUpdating = False
Dim RngColA As Range

Dim I As Range
Dim Dest As Range

Sheets("all").Select
Range("A1").Select

Set RngColA = Range("A1", Range("A" & Rows.Count).End(xlUp))
Set Dest = Sheets("Section 2").Range("A51")
For Each I In RngColA
If I.Value = "FAVO" Then
I.Resize(, 11).Copy Dest
Set Dest = Dest.Offset(1)
End If
Next I

Application.ScreenUpdating = True
End Sub


Any help - mucho appreciated....

P