Find, extract and populate

[Nigh]

Hi all, can someone please help me, I've been searching the site but I can't find exactly what I need. I'm looking for a way to use the code below backwards, i.e. i want to polpulate FROM the destination sheet by searching the source sheet for a value in cell A1 (instead of *Beachcroft*).

I want to populate cols C,D,E,F of the active sheet with data from cells B,C,D,E of the source sheet where col A (of the source sheet) has a value = value in cell A1 (of the active sheet)

The code is:

Sub Populate_remittances()
'Copy cells of cols B,C,D,E from rows containing "Beachcroft" in
'col A of the active worksheet (source sheet) to cols C,D,E,F of Sheet2 (destination sheet)

Dim DestSheet As Worksheet
Set DestSheet = Worksheets("B2 From Beachcroft (2)")

Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long

sCount = 0
dRow = 14

For sRow = 1 To Range("A100").End(xlUp).Row
'use pattern matching to find "Beachcroft" anywhere in cell
If Cells(sRow, "A") Like "*Beachcroft*" Then
sCount = sCount + 1
dRow = dRow + 1
'copy cols A,F,E & D
Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, "C")
Cells(sRow, "C").Copy Destination:=DestSheet.Cells(dRow, "D")
Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "E")
Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "F")
End If
Next sRow

End Sub

Thanks

 

[ISY]

Hello

Wishing you could extract the data directly with advanced filter in the second sheet in one pass (If you can not hand you can do with VBA)

 

[Bill Rockenbach]

Maybe

Option Explicit
Sub CopyData()
    Dim c As Range
    Dim wsSource As Worksheet
    Dim wsDest
    Dim DestRow As Long
    Set wsSource = Sheets("Source")
    Set wsDest = Sheets("Dest")
    With wsSource
        For Each c In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If c.Value = wsDest.Range("A1") Then
                DestRow = DestRow + 1
                wsDest.Cells(DestRow, 3) = c.Offset(0, 1)
                wsDest.Cells(DestRow, 4) = c.Offset(0, 2)
                wsDest.Cells(DestRow, 5) = c.Offset(0, 3)
                wsDest.Cells(DestRow, 6) = c.Offset(0, 4)
            End If
        Next c
    End With
End Sub

 

[Nigh]

Thanks Bill. Works like a charge. Thank you so much.