【VBA】重複データを高速に別ブックとして保存する方法

Option Explicit
Sub ExtractDuplicateData()
    Dim ws As Worksheet, tempWs As Worksheet
    Dim lastRow As Long, i As Long
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False '画面更新停止
    Set ws = ThisWorkbook.Sheets(1) '操作対象のシートを指定
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'データのある最終行取得
    
    For i = 2 To lastRow '1行目はヘッダーなので、2行目からループ開始
        If Not dict.exists(ws.Cells(i, 1).Value) Then '重複チェック
            dict.Add ws.Cells(i, 1).Value, Nothing '重複データを追加
        End If
    Next i
    
    Set tempWs = ThisWorkbook.Sheets.Add '新規シート作成
    For Each key In dict.keys '辞書のキー（重複データ）を取り出す
        tempWs.Cells(tempWs.Rows.Count, 1).End(xlUp).Offset(1, 0) = key '新規シートに書き込み
    Next key
    
    Application.ScreenUpdating = True '画面更新再開
    MsgBox "処理が完了しました。", vbInformation
End Sub