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

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

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

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

Did you say so in the original post?

--
Don Guillett
SalesAid Software

wrote in message
oups.com...
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

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

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

..SpecialCells(xlVisible).entirerow.Copy _


--
Don Guillett
SalesAid Software

wrote in message
ups.com...


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

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

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