【VBA】検索して、コピペする作業を効率化するマクロを作ってみた。

仕事で、大量のデータから必要なカラムだけ取り出すという単純作業をすることがあります。
このカラムが数列だったらいいのですが、
何十列もあったりするとかなり面倒ですし、ミスも起きかねません。
そこで、マクロをつくりました。

Option Explicit
Option Base 1
Sub Search_Copy_Paste()

Dim KeyRange, SearchRange As Range
Dim ResultArray() As Variant                          '検索結果を格納する配列
Dim KeyArray() As Variant                              '元データを格納する配列
Dim SearchArray() As Variant                         '検索先のデータを格納する配列
Dim keyColnum, SearchRownum As Long     '行数と列数
Dim i, j, k As Long                                           'ループ変数

    
    On Error Resume Next
    Set KeyRange = Application.InputBox(prompt:="検索するカラム名を選択してください", Title:="セルの指定", Type:=8)
    If KeyRange Is Nothing Then Exit Sub
    KeyArray = KeyRange.Value
    
    Set SearchRange = Application.InputBox(prompt:="検索対象の範囲を選択してください", Title:="セルの指定", Type:=8)
    If SearchRange Is Nothing Then Exit Sub
    SearchArray = SearchRange.Value
    
    keyColnum = UBound(KeyArray, 2)
    SearchRownum = UBound(SearchArray, 1)
    
    ReDim ResultArray(SearchRownum, keyColnum)
    
    For i = 1 To keyColnum
        
        ResultArray(1, i) = KeyArray(1, i)
        
        For j = 1 To UBound(SearchArray, 2)
            If ResultArray(1, i) = SearchArray(1, j) Then
                For k = 2 To SearchRownum
                    ResultArray(k, i) = SearchArray(k, j)
                Next k
                Exit For
            End If
        Next j
        
    Next i
    
    With KeyRange.Worksheet
    
    Worksheets.Add
    Range(Cells(1, 1), Cells(SearchRownum, keyColnum)).Value = ResultArray
    MsgBox (ActiveSheet.Name & "に転記しました")
    
    End With
    
End Sub