【VBA】重複データを完全一致で抽出する方法

Option Explicit
Sub ExtractDuplicateData()
    Dim ws As Worksheet, wsResult As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim duplicateFound As Boolean
    
    ' データがあるシートを指定
    Set ws = ThisWorkbook.Sheets("データ")
    ' 結果を出力するシートを作成
    Set wsResult = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsResult.Name = "重複結果"
    
    Application.ScreenUpdating = False
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' 最終行を取得
    For i = 2 To lastRow ' データの最初からループ開始
        duplicateFound = False
        For j = 2 To i - 1 ' 同じシート内のデータと比較
            If ws.Cells(i, 1).Value = ws.Cells(j, 1).Value Then ' 完全一致を確認
                duplicateFound = True
                Exit For
            End If
        Next j
        If duplicateFound Then ' 重複が見つかった場合、結果シートに出力
            wsResult.Cells(wsResult.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = ws.Cells(i, 1).Value
        End If
    Next i
    Application.ScreenUpdating = True ' スクリーン更新を再開
End Sub