別のファイルへ条件を指定してセルの値を転記したい

Book1セルE1に書かれたファイル名の転記先シートへ
Book1の転記元シートセルE２の値をセルD2の値をキーにしてBook2の転記先シートC列を検索し、一致したセルの左セルへ転記した
いろいろ試しましたがうまくいきません？

具体的にどのような記述をしたらよいでしょうか？
記述を参考にご指南いただけると助かります。

質問者からの補足コメント

• Dim c, i
  Dim Sh1 As Worksheet: Set Sh1 = Worksheets("受付リスト")
  Dim Sh2 As Worksheet: Set Sh2 = Worksheets("UF")
  With Sh1
  For Each c In .Range("I2", .Cells(Rows.Count, 9).End(xlUp)) 'S2のセルI2以下からS2の9列を検索
  If IsNumeric(c.Value) Then
  i = Application.Match(c.Value, Sh2.Columns(4), 0) 'S1の4列目の送付時連番
  f IsNumeric(i) Then
  c.Offset(, -8).Value = Sh2.Cells(i, 5).Value 'S1の5列目の値をS2送付時連番-6行目のセルへ貼付け
  End If

    補足日時：2022/04/05 10:30

• 上記コードで同一ブックで並べたシートでは転記できましたが、転記先のシートが同一フォルダ内の別ブックにあります。そのブックを開いて検索し、転記後閉じる記述がわかりません？
  
  ご教示いただけると助かります

    補足日時：2022/04/05 10:31

No.4 ベストアンサー 回答者： Qchan1962 回答日時： 2022/04/05 15:53

こんにちは

添付画像とコードはだいぶ違うようですが・・
本当は、躓いている箇所を絞ってご質問して頂けると良いのですが、、

添付図とご説明を基にサンプルコードを書いて見ました
一応、コード内にコメントで処理内容を記していますが、コードを参考に
検索などをして調べてください。
処理の流れも出来るだけ分けるようにしましたが、理解が進みますでしょうか

サンプルはあくまで一例です。方法は色々ありますので探求や視野は広くで。（鵜呑みは厳禁）
ブックが開かれていたり、対象のシート名が無いとエラーが返ります
エラー処理も併せて調べると良いと思います。

Sub sample()
Dim Folder_Path As String
Dim Book_Name As String
Dim FindKey As Long
Dim output_Word As String
Dim c As Range

'入力を確認（D1セルに値がある事）
If WorksheetFunction.CountBlank(Range("D1:E2")) > 0 _
Then MsgBox ("すべて記入してください"): Exit Sub
'開くフォルダは取り合えず実行ブックと同じパス
Folder_Path = ActiveWorkbook.Path & "\"
'転記元シートの必要情報を取得（変数に代入）
With ActiveWorkbook.Worksheets("転記元")
Book_Name = Dir(Folder_Path & .Range("E1").Text & ".xlsx")
If IsNumeric(.Range("D2")) Then
FindKey = .Range("D2")
Else
MsgBox ("検索キーは数値で記入してください"): Exit Sub
End If
output_Word = .Range("E2")
End With
'開くブックの存在を確認
Book_Name = Dir(Folder_Path & Book_Name)
If Book_Name <> "" Then
'対象ブックを開く
With Workbooks.Open(Folder_Path & Book_Name)
'転記先シートをアクティブに
Worksheets("転記先").Activate
With ActiveSheet
'FINDを使い、変数FindKeyを探す
Set c = .Range(.Cells(3, "C"), .Cells(Rows.Count, "C").End(xlUp)) _
.Find(What:=FindKey, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
'有れば　（メイン処理）
c.Offset(, -1) = output_Word
Else
'無ければ
MsgBox ("検索キー：" & FindKey & " は見つかりませんでした"): Exit Sub
End If
End With
MsgBox ("出力しました")
'保存して閉じる
.Close SaveChanges:=True
End With
Else
'対象ブックが無かった時
MsgBox ("ブック名のファイルは存在しません" & vbCrLf & _
"ファイルフルパスは：" & Folder_Path & Book_Name & "です")
End If

End Sub

この回答へのお礼

ありがとうございます。
サンプルコードは勉強になり、思うとうな動きを構築できました。助かりました！

お礼日時：2022/04/05 19:16

No.3 回答者： fujillin 回答日時： 2022/04/04 17:16

こんにちは

＞いろいろ試しましたがうまくいきません？
何を試されたのでしょうか？

＞具体的にどのような記述をしたらよいでしょうか？
説明に曖昧な部分が多いので、具体的なコードにはなりませんが、勝手にいろいろ想定して・・

1）転記先のブックを開く
Workbooks.Open FileName:=対称ファイルのパス

2）シートからキーで検索
対称ブック.対象シート.Columns(3).Find What:=検索キー, LookAt:=xlWhole
あるいは
WorksheetFunction.Match(検索キー, 検索対称範囲, 0)

3)検索結果の行のB列に記入（記入行をnとするなら）
対称ブック.対象シート.Cells(n, 2).Value = 記入値

といった手順でできると思います。

No.2 回答者： 銀鱗 回答日時： 2022/04/04 16:04

(。

´・ω・)ん?
何を試したのかな。
何もしていないのにやった振りをして「代わりに作れ」と言っているように見えるのです。

何をどこまで試したのかを示してください。
何かが足りないのか、見当外れなのかもふくめてアドバイスすることができます。

No.1 回答者： めぐみん_ 回答日時： 2022/04/04 16:00

連番であればセルＢ２に『幾つ足した時の行番号』なのかで、書き込む位置はわかるのでは？

とスマホで書いてみました。