View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] harteorama@googlemail.com is offline
external usenet poster
 
Posts: 24
Default Find/Copy/paste.. then Find/Paste - not working ... at all....

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