VBA: Find (match) from a list, then copy and paste into different sheet

[blonde]

Hi,

I’m wondering if someone could help me please as I’m struggling to get this working. A button click runs a sub containing two with statements. The first one (with ws) works fine. This finds certain records from the main list in worksheet ws, it copies selected columns and pastes the results into worksheet ws2.

I’m having trouble with the second with statement (with ws2). It should look at range F in sheet ws2 (Finalrow2), which has been newly populated under the first with statement (with ws). This column contains unique record values. Using range F, it should find the matching record on worksheet ws3, matching on column E in ws3. From this it should copy a range from the record row in ws3 and then paste into worksheet ws2 from column H.

I’m currently getting an error on this line:

Set pop_fin = ws3.Range("E7:E1000").Find(i, , , xlWhole, , , False, , False)

I’d be very grateful for your help on this.

Here is my code:

Private Sub CommandButton1_Click()
 
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim pop_fin As String
 
Set ws = ThisWorkbook.Sheets("2017-18 student list")
Set ws2 = ThisWorkbook.Sheets("Interim")
Set ws3 = ThisWorkbook.Sheets("QLS 17-18 Download")
 
Finalrow = Sheets("2017-18 student list").Range("A902").End(xlUp).Row
Finalrow2 = Sheets("Interim").Range("F902").End(xlUp).Row
Finalrow3 = Sheets("QLS 17-18 Download").Range("A902").End(xlUp).Row
 
Application.ScreenUpdating = False
 
Sheets("Interim").Range("A2:N902").ClearContents
 
With ws
   
    For i = 7 To Finalrow
   
    If .Cells(i, 1).Value = "Erasmus+ Study" Or _
        .Cells(i, 1).Value = "Erasmus+ Work" Then
                   
    Intersect(.Range("A:F, AO:AO"), .Rows(i)).Copy
    Sheets("Interim").Range("A902").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
       
    End If
    Next i
 
End With
 
With ws2
       
    For i = 2 To Finalrow2
 
    Set pop_fin = ws3.Range("E7:E902").Find(i, , , xlWhole, , , False, , False)
  
    If Not pop_fin Is Nothing Then
  
    Intersect(.Range("F:N"), .Rows(i)).Copy
    ws2.Range("A902").End(xlUp).Offset(1, 8).PasteSpecial xlPasteValues
  
     End If
     Next i
 
End With
 
Application.ScreenUpdating = True
 
End Sub

 

[blonde]

It’s working! Thank you very much for all your time and help on this, I appreciate it. It’s a steep learning curve.

 

[Fluff]

Glad to help & thanks for the feedback