Match Value, Insert Rows, and Copy New Data Between Sheets

[dp694]

Very new to this. I am trying to automate updating a "master" sheet with new information from another sheet that is periodically updated (and still contains data from the sheet it will be going into). Sheet 6 has the new data and Sheet 4 is where it will need to go. Both sheets have a unique ID in column A. I need the macro to look at sheet 6 and find the first match between column A on sheet 6 and cell A3 on sheet 4, then copy all the rows from sheet 6 above the sheet 6 match and insert below the A3 on sheet 4 (below so the vlookups expand). It only needs to find the first match because they are both in descending order and the old sheet 6 data is already in sheet 4.

Sheet 6 data starts in row 2 and sheet 4 data starts in row 3. I started with the macro below but it is probably garbage, I got it to insert the row but it will continue to go through Sheet4 which is pointless because it will just insert a new row every other row so it needs to stop after the first match. Thank you!

Sub Insert()

Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next

Set WorkRng = Range(Sheet6.Range("a3").End(xlDown))
Set WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.Count
Application.ScreenUpdating = False
For xRowIndex = xLastRow To 1 Step -1
Set Rng = Sheet4.Range("A3" & xRowIndex)
If Rng.Value = WorkRng.Value Then
Rng.EntireRow.Insert Shift:=xlDown
End If
Next
Application.ScreenUpdating = True


End Sub

[Mumps1]

Could you attach a copy of your file? It would make it easier to see how your data is organised and to test possible solutions.

[dp694]

Thanks for responding. I cannot due to it being work related but if this helps think of it like

Sheet 6:
Column A
5
4
3
2
1

Sheet 4, Column A:
3
2
1

I need it to copy and insert the rows containing 4 and 5 from Sheet6 underneath the row containing 3 in Sheet4. Is this helpful?

[Mumps1]

Try:

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim foundVal As Range
    Set foundVal = Sheets(6).Range("A:A").Find(Sheets(4).Range("A3").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundVal Is Nothing Then
        Sheets(6).Rows("2:" & foundVal.Row - 1).Copy
        Sheets(4).Rows(4).Insert
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub