Hi there,

Here's one possible VBA solution (one of many I'd imagine):

Sub Macro2()
    
    Dim lngLastRow As Long
    Dim rngCell As Range, _
        rngMyData As Range, _
        rngMyDups As Range
    Dim blnDupsExist As Boolean
    Dim strPasteSheetName As String
    lngLastRow = Sheets("Sheet1").Cells(Rows.Count, "H").End(xlUp).Row
    Set rngMyData = Sheets("Sheet1").Range("H2:H" & lngLastRow)
    blnDupsExist = False
    
    Application.ScreenUpdating = False
    
    For Each rngCell In rngMyData
        If Application.WorksheetFunction.CountIf(rngMyData, rngCell.Value) > 1 Then
            blnDupsExist = True
            If rngMyDups Is Nothing Then
                Set rngMyDups = rngCell.EntireRow
            Else
                Set rngMyDups = Union(rngMyDups, rngCell.EntireRow)
            End If
        End If
    Next rngCell
    
    If blnDupsExist = False Then
        MsgBox "There are no duplicates in the range " & rngMyData.Address & ".", vbExclamation, "My Duplicates Editor"
    Else
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        With rngMyDups
            .Copy Sheets(ActiveSheet.Name).Range("A2")
            .EntireRow.Delete xlShiftUp
        End With
        MsgBox "The duplicates have now been moved to the """ & ActiveSheet.Name & """ tab.", vbInformation, "My Duplicates Editor"
    End If
    
    Application.ScreenUpdating = True
 
End Sub
Regards,

Robert