Find a range of cells in a work book and copy

Dars

New Member
Joined
Jul 23, 2005
Messages
35
Hi Guys, Wahat i want to do is find a value in a cell in col d, go back to col A, find anoher value in COL A and copy all the cells from them first value to the second one. eg if the first vale is found in d3 then look in col A for the second on, then copy all row from A3 dow to the cell that contains the second value.

the code i have to find the first value is

Columns("d:d").Select
Selection.Find(What:=Sheet3.Range("t13").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlUp, _
MatchCase:=False).Activate
ActiveCell.Offset(0, -3).Select

once the first value is found select the same row but in col A. look down the next 30 rows until you find the second value, i thought this might work,

Range(ActiveCell, ActiveCell.Offset(30, 0)).Select

Selection.Find(What:=Sheet3.Range("t14").Value, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlDown, _
MatchCase:=False).Select


but i cant select all rows in between.


Many thanks for any help you can give...
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

lozzablake

Well-known Member
Joined
Dec 15, 2005
Messages
818
Try this. I put in a couple of checks incase the values are not found. I just out range names for the values you are trying to find. You can replace them with your own or actual cell references. In the second find I look at all of column A after the row rather than just 30 rows

Code:
Sub CopyCells()
    Dim fndRange As Range
    Dim fndRange2 As Range


    Set fndRange = Columns("d:d").Find(what:=Range("Value1"))
    
    If Not IsEmpty(fndRange) Then
        Set fndRange2 = Columns("A:a").Find(what:=Range("Value2"), after:=Cells(fndRange.Row, 1))
        
        If Not IsEmpty(fndRange2) Then
            Range(Cells(fndRange.Row, 1), Cells(fndRange2.Row, 1)).Copy
        Else
            MsgBox "second value not found"
        End If
    Else
                MsgBox "first value not found"
    End If

End Sub
 

Dars

New Member
Joined
Jul 23, 2005
Messages
35
Hi Lozzablake,

With one or 2 slight changes it works perfect. Many thanks again.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,287
Messages
5,571,318
Members
412,382
Latest member
Langtn02
Top