【VBA】重複データをバックグラウンドで転記する方法

Option Explicit
Sub DuplicateDataTransfer()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRowSrc As Long, i As Long, j As Long
    Dim duplicateFound As Boolean
    
    ' シートを指定
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsDest = ThisWorkbook.Sheets("DuplicateData")
    
    ' データの最終行を取得
    lastRowSrc = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 背景処理開始
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For i = 1 To lastRowSrc
        duplicateFound = False
        For j = 1 To wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
            If wsSource.Cells(i, 1) = wsDest.Cells(j, 1) Then
                duplicateFound = True
                Exit For
            End If
        Next j
        
        ' 重複データを転記
        If Not duplicateFound Then
            wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1, 0) = wsSource.Cells(i, 1)
        End If
    Next i
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "転記が完了しました。"
End Sub