【VBA】重複データを配列を使って高速に転記する方法

Option Explicit
Sub DuplicateDataTransfer()
    Dim ws As Worksheet, arr() As Variant, lastRow As Long, i As Long, j As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ReDim arr(1 To lastRow)
    Application.ScreenUpdating = False
    For i = 1 To lastRow
        If IsInArray(arr(), ws.Range("A" & i)) Then
            j = j + 1
            arr(j) = ws.Range("A" & i).Value
        End If
    Next i
    ReDim Preserve arr(1 To j)
    ws.Range("B2").Resize(j, 1).Value = Application.Transpose(arr)
    Application.ScreenUpdating = True
End Sub
Function IsInArray(value As Variant, arr() As Variant) As Boolean
    Dim i As Long
    For i = LBound(arr) To UBound(arr)
        If value = arr(i) Then
            IsInArray = True
            Exit Function
        End If
    Next i
    IsInArray = False
End Function