Find/Copy/paste.. then Find/Paste - not working ... at all....

[harteorama]

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

 

[Don Guillett]

maybe autofilter the source>copy all of the visible cells at once to the
destination sheet where you FIND avon and insert the rows

 

[harteorama]

Hi Don,

I don really want to do the manual copy and paste thing.. the reason is
that i have ~50+ different 'F???' type find/copy/paste requirements. If
i manually copy and paste, i'd be doing it forever..

Many thanks for your response.

P

 

[Don Guillett]

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]

Did you say so in the original post?

 

[harteorama]

Hi Don,


In your code (that you have kindly provided) which one of the 'Sheet23'
do i change so that it relates to my sheet 'Section 2' (i.e. where i
want to find Avon and paste below)? This is a different sheet to where
the data is.

Cheers

Paul

 

[harteorama]

Hi Don,

I modified the code... and it copies the FAVO cell from the data sheet
to Section 2 - how do i get it to copy the whole row?

Sub copiedfiltereddata()
mr = Sheets("Section 2").Columns(1).Find("avon").Row
With Range("a2:a70")
..AutoFilter Field:=1, Criteria1:="favo"
mc = .SpecialCells(xlVisible).Count
Sheets("section 2").Rows(mr + 1 & ":" & mr + mc).Insert
..SpecialCells(xlVisible).Copy _
Sheets("section 2").Cells(mr + 1, 1)
..AutoFilter
End With
End Sub

Cheers

P

 

[Don Guillett]

..SpecialCells(xlVisible).entirerow.Copy _

 

[harteorama]

Hi Don,

Thanks fantastic... but..... !

If i repeat the code but, looking for another item in the data i.e.
Ham. When it copies the data into Section 2, it inserts lots of blank
lines..

i.e.

Row 2 = Avon
Row 3 = blank
Row 4 = Ham

After i run the code, it inserts the items from the data, but, the
amount of blank lines goes up to 13! any ideas...... the code i ran is
below....


Sub copiedfiltereddata1()
mr = Sheets("Section 2").Columns(1).Find("avon").Row
With Range("a2:a70")
..AutoFilter Field:=1, Criteria1:="favo"
mc = .SpecialCells(xlVisible).Count
Sheets("section 2").Rows(mr + 1 & ":" & mr + mc).Insert
..SpecialCells(xlVisible).EntireRow.Copy _
Sheets("section 2").Cells(mr + 1, 1)
..AutoFilter
End With
End Sub


Sub copiedfiltereddata2()
mr = Sheets("Section 2").Columns(1).Find("ham").Row
With Range("a2:a70")
..AutoFilter Field:=1, Criteria1:="fham"
mc = .SpecialCells(xlVisible).Count
Sheets("section 2").Rows(mr + 1 & ":" & mr + mc).Insert
..SpecialCells(xlVisible).EntireRow.Copy _
Sheets("section 2").Cells(mr + 1, 1)
..AutoFilter
End With
End Sub

 

[Don Guillett]

Contact me privately for custom work.