Match within multiple LRs

[bgonen]

I got two worksheets; Source and Target

Source got data from column A10 through C10 all the way down to the used cell (range is dynamic; it can be A10:C90 but it can vary)

I'm trying to match cell A1 in Target worksheet with the range of A:C (in source)

For example: If A1 (Target ws) matches cell B46 in Source ,,then copy D46 through K46 in source to Target ws starting at A2,,then continue the search If A1 (Target ws) matches cell B50 in Source ,,then copy D50 through K50 in source to Target ws (this time it will start at A3)

Another example if A1 (Target ws) matches cell C12 in Source ,, then copy D12 through K12 in source to Target ws starting at A2

 

[Ralajer]

Give this a try:

Sub searchcopy()
    
    Dim searchRng As Range
    Dim searchFor As Variant
    Dim found As Range
    Dim firstFound As Range
    Dim copyRow As Long
    Dim outRow As Long
    Dim sWS As Worksheet
    Dim tWS As Worksheet
    
    Set sWS = Sheets("Source")
    Set tWS = Sheets("Target")
    
    Set searchRng = sWS.Range("A9:C" & Rows.Count)

    searchFor = tWS.Range("A1").Value
    
    outRow = 2
    
    Set found = searchRng.Find(what:=searchFor, After:=searchRng(1, 1), _
                                LookIn:=xlValues, Lookat:=xlWhole, _
                                SearchOrder:=xlRows, searchdirection:=xlNext)
    Set firstFound = found
    
    Do While True
        
        If found Is Nothing Then Exit Do
        'Skip Copying same rows if search for item is in multiple columns
        If copyRow <> found.Row Then
            copyRow = found.Row
            sWS.Range("D" & copyRow, "K" & copyRow).Copy _
                                        Destination:=tWS.Range("A" & outRow)
            outRow = outRow + 1
        End If
        
        Set found = searchRng.FindNext(found)
        If Not Intersect(found, firstFound) Is Nothing Then Exit Do
    Loop
    
End Sub

 

[bgonen]

Thanks for the effort Rob
I was hoping to edit codes that I already have such as below:
For Each ws In Sheets(Array("Source1", "Source2")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = j To LR
With .Range("A" & i)
If IsNumeric(Application.Match(.Value, Sheets("Target").Columns("A"), 0)) Then
On Error Resume Next
.EntireRow.SpecialCells(12).Copy
Sheets("Target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
On Error GoTo 0
End If
End With
Next i
End With
Next ws

I was hoping to edit the LR code but I keep getting range errors

Thanks again

 

[Ralajer]

I tried this and and didn't get any range errors. I only moved the what I assume you intended the to be the first with statement into the for loop.

Sub foo()
    Dim ws As Worksheet
    Dim LR As Long
    Dim i As Long
    Dim j As Long
    
    j = 2

    For Each ws In Sheets(Array("Source1", "Source2"))
        [B]With ws[/B]
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        For i = j To LR
            With .Range("A" & i)

            If IsNumeric(Application.Match(.Value, Sheets("Target").Columns("A"), 0)) Then
                On Error Resume Next
                .EntireRow.SpecialCells(12).Copy
                Sheets("Target").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
                On Error GoTo 0
            End If
            End With
        Next i
        End With
    Next ws
End Sub

Your code doesn't do what you asked for in your original post though.