アプリ版:「スタンプのみでお礼する」機能のリリースについて

【やりたい事】
以下のコードをご覧ください。

コード説明です
ファイル名やシート名の場所が一切、変わらない場合に転記元ファイルのA1~C1のセルの値が
別フォルダの、book2へ最終行に転記されます。本マクロは動きます。

同マクロは転記先の名前が固定のファイルの場所ですが


今回は

転記先のファイル名が、毎回変わる場合のマクロを知りたいです。シート名は変わりません。

転記元のファイル名は変わりません。転記先のみ変わります。
転記先の、ファイルとシート名は、常に、以下の場所★にて取得します

ご存じの方、教えて下さい



【転記元ファイル・シート】

・ファイル名
C:\Users\2020\OneDrive\Shinji\マクロ\テストフォルダ1\転記元.xlsx

・シート名
転記元


【今現在の、固定の転記先ファイル・シート】

・ファイル名
C:\Users\2020\OneDrive\マクロ\テストフォルダ1\Book2.xlsx

・シート名
Sheet1


★【常に変更となる転記先ファイル・シート】
【転記元ファイル・シート】のA1セル
例C:\Users\2020\OneDrive\マクロ\テストフォルダ1\20240502Book2.xlsx

【転記元ファイル・シート】のB1セル
例Sheet1



【転記元ファイルのA1-B3セルの値をbook2セルのSheet1の最終行のA1-B3に転記するコード】




Sub 別ブックへ転記2()


Dim ws1 As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet


Dim maxrow2 As Long
Dim row2 As Long


Set ws1 = Worksheets("転記元")


Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & "Book2.xlsx")
Set ws2 = wb2.Worksheets("Sheet1")

maxrow2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
row2 = maxrow2 + 1

ws2.Cells(row2, 1).Resize(1, 3).Value = ws1.Cells(1, 1).Resize(1, 3).Value


wb2.Save


MsgBox ("完了")

End Sub

A 回答 (2件)

Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & "Book2.xlsx")


Set ws2 = wb2.Worksheets("Sheet1")

Set wb2 = Workbooks.Open(wb1.Range("A1").Value)
Set ws2 = wb2.Worksheets(wb1.Range("B1").Value)
とすればOKでしょう。
    • good
    • 0
この回答へのお礼

お返事ありがとうございます
動きませんでした

ちなみに、 wb1 の定義はする必要ありますでしょうか?
以下がWB1 の場所です。

転記元も先もどちらも開いている前提なので
定義は必要ないということでしょうか?

ご教授くださいませ

【ファイル名】
"C:\Users\2020\OneDrive\マクロ\転記元.xlsx"

【シート名】
Sheet1

お礼日時:2024/05/02 21:29

Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\" & "Book2.xlsx")


Set ws2 = wb2.Worksheets("Sheet1")

Set wb2 = Workbooks.Open(ws1.Range("A1").value)
Set ws2 = wb2.Worksheets(ws1.Range("B1").value)
にすれば良いかと思います。
(動作確認はしていません。期待した結果が得られない場合は、その旨、補足してください)
    • good
    • 0
この回答へのお礼

ありがとうございます。動きました。
次回、また、ご指導、お願いします

お礼日時:2024/05/03 09:14

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A