【マクロ・VBA】別ファイルをインポートしてインデックスマッチで項目列に追加する

Sub 別ファイルをアクティブシートにインポートしてインデックスマッチでマッチング()

'このファイル
Dim wb1 As Workbook
    Set wb1 = ThisWorkbook
Dim ws1 As Worksheet
    Set ws1 = wb1.ActiveSheet
Dim LastRow1 As Long
    LastRow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Dim LastCol1 As Long
    LastCol1 = ws1.Cells(1, Columns.Count).End(xlToLeft).Column


YES_TASK500:

'1つ目のインポートするファイル開く
'Dim FName As String
MsgBox "「対象ファイル」選択"
FName = Application.GetOpenFilename("Microsoft ExcelブックorＣＳＶ,*.*")  ' "\*.*")

If FName <> "False" Then
   Dim wb2 As Workbook
        Set wb2 = Workbooks.Open(FName)
   Dim ws2 As Worksheet
        Set ws2 = wb2.Worksheets(1)
   Dim LastRow2 As Long
        LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
   Dim LastCol2 As Long
        LastCol2 = ws2.Cells(1, Columns.Count).End(xlToLeft).Column
Else
    MsgBox "File未選択 "
End
End If
    
Skip:
    
ws1.Activate

'ディクショナリ作成-----------------
'Dictionaryオブジェクトの宣言
Dim dicGyoukoumoku As Object     '元表の社名行番号ディクショナリ
Dim dicRetukoumoku As Object     '元表の項目名列番号ディクショナリ

Set dicGyoukoumoku = CreateObject("Scripting.Dictionary")
Set dicRetukoumoku = CreateObject("Scripting.Dictionary")

Const ws2_KEY_CLM As Long = 1 '「元表」シートのキー列（社名列：C列）
Const ws2_KEY_ROW As Long = 1 '「元表」シートのキー行（項目見出し行:１行目）

Dim iRRow As Long        '元表シートの読込行(ws2)
Dim iRCol As Long        '元表シートの読込列(ws2)

        'あいて表シート（２行目から最終行）から社名のディクショナリを作成
        For iRRow = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
        'For iRRow = 2 To ws2.Cells(2, ws2_KEY_CLM).End(xlDown).Row
        DoEvents
        
            '社名をキーとして行番号をディクショナリに保管（同じ社名が複数存在した場合、後勝ちで行番号が上書きされます）
            dicGyoukoumoku(ws2.Cells(iRRow, "A").Value) = iRRow     '(ws2)
        Next
    
        'あいて表シート（2列目から最終列）から項目名のディクショナリを作成
        For iRCol = 2 To ws2.Cells(1, Columns.Count).End(xlToLeft).Column
        'For iRCol = 2 To ws2.Cells(ws2_KEY_ROW, 1).End(xlToRight).Column
        DoEvents
        
            '項目名をキーとして列番号をディクショナリに保管
            dicRetukoumoku(ws2.Cells(1, iRCol).Value) = iRCol
        Next


'転記処理----------------------------
Const ws1_CLM As Long = 1 '「転記先」シートA列（社名列：C列）
Const ws1_ROW As Long = 1 '「転記先」シート１行目（項目見出し行:１行目）

    Dim iWRow As Long        '転記先シートの出力行(ws1)
    Dim iWCol As Long        '転記先シートの出力列(ws1)

Do

        'あいて転記先シート（5行目から最終行）の社名ループ
        For iWRow = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row                     '社名から元表の行番号を取得
        
        DoEvents
    
            If dicGyoukoumoku.Item(ws1.Cells(iWRow, ws1_CLM).Value) = "" Then         '社名から行番号が取得できない場合は何もしない
            Else
                iRRow = dicGyoukoumoku.Item(ws1.Cells(iWRow, ws1_CLM).Value)            '元表の行番号を取得
            End If
        
                'あいて転記先シートの項目ループ-------------
                For iWCol = 1 To ws1.Cells(1, Columns.Count).End(xlToLeft).Column              '項目名から元表の列番号を取得
                
                DoEvents
                    If dicRetukoumoku.Item(ws1.Cells(ws1_ROW, iWCol).Value) = "" Then          '項目名から列番号が取得できない場合は何もしない
                    Else
                        iRCol = dicRetukoumoku.Item(ws1.Cells(ws1_ROW, iWCol).Value)            '元表の列番号を取得
                        ws1.Cells(iWRow, iWCol).Value = ws2.Cells(iRRow, iRCol).Value      '「元表」シートの取得行・取得列のセルの値を、「転記先」シートの出力行・出力列に出力する
                    End If
                Next iWCol
        Next iWRow

    'ActiveWorkbook.Close savechanges:=False  'ActiveWorkbook.Close savechanges:=True

'buf = Dir()
Loop '----------------------DO LOOP


'相手ファイル閉じる
Application.CutCopyMode = False
wb2.Close savechanges:=False

'継続？
'表示形式を変更しますか？
Dim ret As VbMsgBoxResult
ret = MsgBox("突合ファイルを追加しますか？追加は「はい」／終了の場合は「いいえ」", vbYesNo)

If ret = vbYes Then
    GoTo YES_TASK500
Else
    GoTo NO_TASK3
End If

NO_TASK3:

'コピーモード解除
Application.CutCopyMode = False

ws1.Range("A1").Select

MsgBox "完了"
End Sub