VBA to Insert Mismatched Row in separate worksheet

[MacOrch]

Long time lurker, first time poster. Usually I can find what I need in previous threads, but this one has beat me.

I have 2 worksheets that I use the below code to compare data in the two.
The code looks for the ID number in Sheet1 ColumnA and matches it to the ID number in Sheet2 ColumnA. Any cells in that row that do not match are highlighted on Sheet2 in yellow. Any missing ID from column A are highlighted red.

My question is how can I copy the entire row of the mismatched cells from Sheet2 and insert it below the corresponding row in Sheet1, and add the missing ID rows the bottom of the data in Sheet1.

Ideally Sheet1 end result would look like this:

Sub Changes()
Range("A1").Select

    Dim ws1 As Worksheet, Ws2 As Worksheet
    Dim ws1Data As Range, f As Range, cell As Range
    Dim icol As Long

    Set ws1Data = Worksheets("Sheet1").Columns(1).SpecialCells(xlCellTypeConstants)

    With Worksheets("Sheet2")
        For Each cell In Intersect(.UsedRange, .Columns(1)).SpecialCells(xlCellTypeConstants)
            Set f = ws1Data.Find(what:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If f Is Nothing Then
                Intersect(cell.EntireRow, .UsedRange).Interior.ColorIndex = 3
            Else
                For icol = 1 To .Range(cell, .Cells(cell.Row, .Columns.Count).End(xlToLeft)).Columns.Count - 1
                    If f.Offset(, icol) <> cell.Offset(, icol) Then
                        cell.Offset(, icol).Interior.ColorIndex = 6
                        
                    End If
                Next icol
            End If
        Next cell
End With
Range("A1").Select

End Sub

 

[MacOrch]

Thanks Peter. Works great.

 

[Peter_SSs]

Cheers - you are welcome.