Try this.
Sub x()
    Dim rTest       As Range
    Dim rLook       As Range
    Dim rFind       As Range
    Dim sAddr       As String
    Dim iRow        As Long

    With Me
        Set rTest = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
    End With

    With Sheet2
        Set rLook = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
    End With

    For iRow = rTest.Rows.Count To 1 Step -1
        Set rFind = rLook.Find(What:=rTest(iRow).Text, After:=rLook(1), _
                               SearchDirection:=xlPrevious, _
                               MatchCase:=False, MatchByte:=False, _
                               SearchFormat:=False)
        If Not rFind Is Nothing Then
            sAddr = rFind.Address
            
            Do
                Application.CutCopyMode = False
                With rTest(iRow, 1)
                    .EntireRow.Copy
                    .Offset(1).Insert
                    rFind.EntireRow.Resize(, Columns.Count - 1).Copy Destination:=.Offset(1, 1)
                End With
                Set rFind = rLook.Find(What:=rTest(iRow).Text, After:=rFind, _
                                       SearchDirection:=xlPrevious)
            Loop Until rFind.Address = sAddr
        End If
            
        rTest(iRow, 1).EntireRow.Delete
    Next iRow
    
    Application.CutCopyMode = xlCopy
End Sub