【VBA】重複データを高速に転記する方法

Option Explicit
Sub DuplicateDataTransfer()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSrc As Long, lastRowTgt As Long, i As Long
    
    ' ソースとターゲットのワークシートを指定
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    
    ' 画面更新停止（高速化）
    Application.ScreenUpdating = False
    
    ' ソースシートの最終行を取得
    lastRowSrc = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' ターゲットシートの最終行を取得
    lastRowTgt = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
    
    ' データ転記処理開始
    For i = 2 To lastRowSrc
        If IsDuplicate(wsSource.Range("A" & i)) Then
            wsTarget.Cells(lastRowTgt, "A").Value = wsSource.Cells(i, "A").Value
            lastRowTgt = lastRowTgt + 1
        End If
    Next i
    
    ' 画面更新再開
    Application.ScreenUpdating = True
End Sub

' 重複チェック関数
Function IsDuplicate(cell As Range) As Boolean
    Dim wsTarget As Worksheet, lastRowTgt As Long
    Set wsTarget = ThisWorkbook.Sheets("Sheet2")
    lastRowTgt = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    
    ' ターゲットシートのデータと比較
    If Application.WorksheetFunction.CountIf(wsTarget.Range("A1:A" & lastRowTgt), cell.Value) > 0 Then
        IsDuplicate = True
    Else
        IsDuplicate = False
    End If
End Function