VBA：指定のファイルから別ファイルへデータのコピーを行いたい

Question

VBAで指定の参照元ファイルから指定の別ファイルへデータのコピーが行いたいです。

File_A(参照元)、File_B(移行先)の2ファイルがあります
File_Aから「No.10」を検索し、その行のデータを別ファイルの指定ヵ所にコピーしたいです。

▼File_A(イメージ)

▼File_B(イメージ)

更に別ファイルでファイル名を選択し、その名に応じてコピーするデータを変えたいので、
上記以外のコードが入っていますがかなり手前の方で煮詰まってしまいました。

Sub データの取込()    '指定したファイル(参照元ファイル)を取り込み、別ファイル(データ移行先)に貼り付ける

  Dim SetFile As String
  Dim BaseFile, migrationFile As Workbook
  Dim File_A, File_B As String

  File_A = 参照元ファイル
  File_B = 移行先ファイル  
  
  '[参照元ファイル]データ取込セット
  Set BaseFile = ActiveWorkbook
  
  Application.DisplayAlerts = False
  
  'データファイルの取込場所をセット
  If Range(C2) = File_A Then
    SetFile = "C:\Users\XXX\YYYYY.xlsx"
    'ファイルを読み取り専用で開く
    Workbooks.Open Filename = SetFile, ReadOnly:=True, UpdateLinks:=0
    '開いたファイルをセット
    Set BaseFile = Workbooks.Open(SetFile)
        'No.の検索

End Sub

Comments

[y_waiwai]

問題はなんでしょうか

Answer 1

こまかい仕様は不明なので、
とりあえず、イメージ画像を元に、参照元から移行先にコピーするコード例です。

Sub データの取込()
    '検索No.
    Dim findNo As String
    findNo = "No.10"

    '参照元ブックを開く
    Dim Moto As Workbook
    Set Moto = Workbooks.Open("C:\Users\XXX\参照元.xlsx")
    '移行先ブックを開く
    Dim Saki As Workbook
    Set Saki = Workbooks.Open("C:\Users\XXX\移行先.xlsx")
    
    '参照元シート
    Dim Moto As Worksheet
    Set MotoS = Moto.Worksheets(1)
    Dim SakiS As Worksheet
    Set SakiS = Saki.Worksheets(1)
    
    On Error Resume Next
    'No.の検索
    Dim r As Long
    r = WorksheetFunction.Match(findNo, MotoS.Range("B3:B" & Rows.Count), 0)
    If Err <> 0 Then
        MsgBox findNo & "は存在しません。"
        Exit Sub
    Next
    On Error GoTo 0

    '転記処理
    SakiS.Range("B3").Value = findNo
    SakiS.Range("C3").Value = MotoS.Range("C" & r).Value
    SakiS.Range("C4").Value = MotoS.Range("E" & r).Value
    SakiS.Range("C5").Value = MotoS.Range("D" & r).Value
    SakiS.Range("C6").Value = MotoS.Range("F" & r).Value

End Sub