別ブック(複数)から指定列の値をコピーペーストする方法

キーワード検索で指定フォルダ内のファイル名一覧を取得する方法 ExcelVBA
の続きになります。

#ユーザーから見た画面の流れ

①データを取得・貼付ボタンを押下
②検索結果 ファイル名を元にデータの取得・貼付開始

###結果
各ファイル名とデータが貼付けられます。
B列とD列のデータがある行までをコピーしてくるように指示しています。

コピー先のテストデータは以下の通りです。
各シート名はすべて、"取り込むシート"として、
C:\test\ディレクトリの下に置いてあります。

Sub データ取込貼付()

    Const Path As String = "C:\test\" '固定ディレクトリパス'
    
    Dim SetFile As String
    Dim wbCopy, wbPaste As Workbook
    Dim row As Integer
    Dim cnt As Long 'カウント'
    Dim FileName As String
    Dim NextRow As Long
    
    row = 7
    cnt = 6
    
    Do Until ThisWorkbook.Worksheets("マクロ定義シート").Cells(row, 2).Value = ""
    
        cnt = cnt + 1
        FileName = ThisWorkbook.Worksheets("マクロ定義シート").Cells(cnt, 2)
        SetFile = Path + FileName
    
        Set wbPaste = ThisWorkbook
        Set wbPaste = ActiveWorkbook
        
         Application.DisplayAlerts = False

        Workbooks.Open FileName:=SetFile, ReadOnly:=True, UpdateLinks:=0 '読み取り専用で開く
        Set wbCopy = Workbooks.Open(SetFile)
        
            wbCopy.Worksheets("取り込むシート").Range("B2", Range("B1").End(xlDown)).Copy '★選択1列目コピー
            
            NextRow = ThisWorkbook.Worksheets("貼付先シート").UsedRange.SpecialCells(xlCellTypeLastCell).row + 1 '☆最終行から追加する
            
            wbPaste.Worksheets("貼付先シート").Range("A" & NextRow + 1) = FileName    'ファイル名記入
            wbPaste.Worksheets("貼付先シート").Range("B" & NextRow + 1).PasteSpecial xlPasteFormulasAndNumberFormats '★選択1列目貼付
    
            wbCopy.Worksheets("取り込むシート").Range("D2", Range("D1").End(xlDown)).Copy '★選択2列目コピー
            wbPaste.Worksheets("貼付先シート").Range("D" & NextRow + 1).PasteSpecial xlPasteFormulasAndNumberFormats '★選択2列目貼付
            
            Application.CutCopyMode = False  'コピー切り取りを解除
            wbCopy.Close False  'マスターデータ取り込み先のファイルを閉じる
    
        Application.DisplayAlerts = True
        
        row = row + 1
        
    Loop
    
End Sub