Copy Paste from specific row to specific row in another sheet

[dugden]

Sheet A

	A	B	C
1	Name	Policy	Amount
2	Paul	234	50
3	Paul	234	100
4	Sharon	365	20
5	sharon	365	40
6	shane	976	100
7	andrea	573	30
8	andrea	573	30
9	andrea	573	50

<tbody>
</tbody>

Sheet B

	A	B	C
	Name	Policy	Amount
1	Andrea	573	100
2	Gary	497	70
4	Shane	976	100
5	Paul	234	140
6	Sharon	365	90

<tbody>
</tbody>

Sheet C

	A	B	C
	Name	Policy	Amount
1	Andrea	573	100
2	Andrea	573	30
3	Andrea	573	30
4	Andrea	573	50
5	Gary	497	70
6	Shane	976	100
7	Paul	234	140
8	Paul	234	50
9	Paul	234	100
10	Sharon	365	90
11	Sharon	365	20
11	Sharon	365	40

<tbody>
</tbody>

I need to produce a report as detailed in Sheet C being a concatenation of SheetsA & B as outlined.
All similar policy found in Sheet A are copied and inserted at the cell below it's corresponding policy.
So in the instance where Paul with policy number 234 is found in SheetB his matching policy is copied (entire row) form Sheet A into sheet B

Note. I have created a copy of sheet B which is used to loop over the policy range. This sheet will be the source and used to move the rows between sheets.


Here is the code thus far

Sub Macro2()
Dim i As Long, j As Long, RefLastRow As Long, MarLastRow As Long, WSLastRow As Long
Dim refPolicy As String, myWkShtAddr As String
Dim ws As Worksheet, mar As Worksheet, ref As Worksheet
Dim wsRange As Range
Dim k As Integer



Set ws = Sheets("Worksheet")
Set mar = Sheets("Marathon")
Set ref = Sheets("WS_Data")


RefLastRow = ref.Range("H" & Rows.Count).End(xlUp).Row
WSLastRow = ws.Range("H" & Rows.Count).End(xlUp).Row


For i = 2 To RefLastRow
refPolicy = ref.Cells(i, "H").Value
mar.Activate
MarLastRow = mar.Range("N" & Rows.Count).End(xlUp).Row
For j = 2 To MarLastRow
If mar.Cells(j, "N").Value = refPolicy Then
On Error Resume Next
With ws
Set wsRange = ws.Range(“H2:H” & WSLastRow).Find(What:=refPolicy, Lookin:=xlValues) '\\This gives error,not sure why.




If Not wsRange Is Nothing Then
k = 0
firstAddress = wsRange.Address
Do
mar.Select
mar.Range(Cells(j, "A")).Copy
ws.Select
NextRow = ws.Range.Address.Row + 1 '\\ Not sure how to do the insert here
Cells(NextRow, 1).Select
ActiveSheet.Paste


mar.Range(Cells(j)).EntireRow.Copy Destination:=ws.Range(wsRange).Offset(j, k)




Set wsRange = .FindNext(wsRange)
Loop While Not wsRange Is Nothing And wsRange.Address <> firstAddress

End If
End With

End If
Next j
Application.CutCopyMode = False
Next i
ref.Activate
ref.Range("A1").Select


End Sub

 

[My Aswer Is This]

Why not copy all the rows in sheet ("A") and paste them into sheet ("B") and then sort sheet "B" by policy number?