Copy row from source Sheet 1 to Sheet 2 and paste below matching cell values

[B4andafter]

Hello, I am having a difficult time figuring out a way to copy rows based on cell value in column E from source worksheet Sheet 1 to Sheet 2 Master file. I would like to paste below corresponding matching cells value in column E and leave empty space between different amounts. See snippts below. Also, it would be great if you can help me list the ones that were not found. Thank you all in advance.

Sheet1 (Source)

Sheet2 (Master File)

RESULTS:

Below is the code I am using but is not working properly.

Sub transfer()
Dim i As Long, j As Long, lastrow2 As Long
Dim lastrow1 As Long
Dim FinalRow As Long

Dim myNum As Integer
Dim LastRowPFW As Integer

Sheets(1).Select
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To FinalRow
myNum = Sheets(1).Cells(i, 5).Value
Sheets(2).Activate
lastrow2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To lastrow2
If Sheets(2).Cells(j, 5).Value = myNum Then
Sheets(1).Activate
Sheets(1).Range(Cells(i, 1), Cells(i, 5)).Copy
Sheets(2).Activate
LastRowPFW = Range("A:E").Find(what:=myNum, after:=Range("A" & i & ":E" & i), searchdirection:=xlPrevious).Row
Sheets(2).Range(Cells(j, 1), Cells(j, 5)).Select.Offset(1).Row
ActiveSheet.Paste
End If
Next j
Application.CutCopyMode = False
Next i
Sheets(1).Activate
Sheets(1).Cell(“E2”).Select
End Sub

Warm Regards,

Bfandafter from Houston, TX

 

[Zot]

Not need to use Activate and Select. Avoid if possible. It will slow down execution. You can declare worksheet as parameter and directly call from there.
Here is my alternative

Sub SortByAmount()

Dim eRow As Long
Dim cell As Range, rngSource As Range, rngMaster As Range, rngFound As Range
Dim wsSource As Worksheet, wsMaster As Worksheet

Set wsSource = ActiveWorkbook.Sheets("Source")
Set wsMaster = ActiveWorkbook.Sheets("Master")

Set rngSource = wsSource.Range("E2", wsSource.Cells(Rows.Count, "E").End(xlUp))
Set rngMaster = wsMaster.Range("E2", wsMaster.Cells(Rows.Count, "E").End(xlUp))

Application.ScreenUpdating = False

For Each cell In rngSource
    eRow = wsMaster.Cells(Rows.Count, "E").End(xlUp).Offset(1).Row
    Set rngMaster = wsMaster.Range("E2", "E" & eRow)
    Set rngFound = rngMaster.Find(cell, LookAt:=xlWhole, searchDirection:=xlPrevious)
    If Not rngFound Is Nothing Then
        If Not IsEmpty(wsMaster.Range("A" & rngFound.Row).Offset(2)) Then
            wsMaster.Range("A" & rngFound.Row).Offset(1).EntireRow.Insert
            wsSource.Range("A" & cell.Row, "E" & cell.Row).Copy wsMaster.Range("A" & rngFound.Row).Offset(1)
        Else
            wsSource.Range("A" & cell.Row, "E" & cell.Row).Copy wsMaster.Range("A" & rngFound.Row)
        End If
    Else
        If Not eRow = 2 Then
            wsMaster.Range("A" & eRow).EntireRow.Insert
            wsSource.Range("A" & cell.Row, "E" & cell.Row).Copy wsMaster.Range("A" & eRow).Offset(1)
        Else
            wsSource.Range("A" & cell.Row, "E" & cell.Row).Copy wsMaster.Range("A" & eRow)
        End If
    End If
Next

Application.ScreenUpdating = True
    
End Sub

 

[B4andafter]

Fantastic sir, your alternative is much better and provide correct results. Thank you so much responding so quickly. You guys are also our heroes, you rock.

Many Blessings,
Pedro