VBA Find and copy

jeskit · December 5th, 2011, 11:49 AM

HI,

I was wondering if anyone knew whether it is possible to build a macro which will loop through a list on sheet1, then for each cell in that list perform a find on the range a:a in sheet2. For each each row it finds in sheet2, copy the row and paste it in a new line in sheet3.

Currently i have the following however its not performing the copy and paste section:

Code:

Dim BacSht1 As Worksheet
Dim BacSht2 As Worksheet
Dim BacSht3 As Worksheet
Dim Broker As String
Dim Cell As Range
Dim FoundCell As Range
Dim LastCell As Range
Dim FirstAddr As String

Set Bac = Workbooks.Open("O:\Emma's Handover\Remittance Advice\bacscomms.csv")

Bac.Sheets.Add.Name = "Sheet1"
Bac.Sheets.Add.Name = "Sheet2"

Set BacSht1 = Bac.Sheets("bacscomms")
Set BacSht2 = Bac.Sheets("Sheet1")
Set BacSht3 = Bac.Sheets("Sheet2")

For Each Cell In BacSht2.Range("A:A")

With BacSht1.Range("A:A")
    Set LastCell = .Cells(.Cells.Count)
End With
Set FoundCell = BacSht1.Range("A:A").Find(what:="a", after:=LastCell)

If Not FoundCell Is Nothing Then
    FirstAddr = FoundCell.Address
End If
Do Until FoundCell Is Nothing
    FoundCell.Copy
    BacSht3.Select
    Range("B1").PasteSpecial
    Set FoundCell = BacSht1.Range("A:A").FindNext(after:=FoundCell)
    If FoundCell.Address = FirstAddr Then
        Exit Do
    End If
    
Loop

Next Cell

Has anyone got any ideas?

Thank you!

Jeskit