『セルの値を取得して実行させるには』（はみご）
お世話になります。
「転記」シートに入力されている、K2にはコピー先のシート名が｢R0704｣。
M1にはコピー元(開くファイル)で２種類あり、M2、M3に(ファイルの場所の)パスが入力されております。
下記のコードでセルの値を取得して実行させたいですが、どのように変更したらよいのかわかりません。
sourceFile1…M2の値
sourceFile2…M3の値
sourceSheet1 …K2の値
よろしくお願いいたします。
Sub CopyRangeFromFiles()
Dim sourceFile1 As String
Dim sourceFile2 As String
Dim destFile As String
Dim sourceSheet1 As String
Dim sourceSheet2 As String
Dim destSheet As String
Dim sourceRange1 As String
Dim sourceRange2 As String
Dim sourceRange3 As String
Dim sourceRange4 As String
Dim sourceRange5 As String
Dim destRange0 As String
Dim destRange1 As String
Dim destRange2 As String
Dim destRange3 As String
Dim destRange4 As String
Dim destRange5 As String
Dim wbSource1 As Workbook
Dim wbSource2 As Workbook
Dim wbDest As Workbook
' ファイルパスとシート名、セル範囲を設定
sourceFile1 = "C:\Users\Owner\Dropbox\(株)○○\オーダー数量\オーダー R07（2025）\太平洋・R07 .xlsx"
sourceFile2 = "C:\Users\Owner\Dropbox\(株)○○\オーダー数量\オーダー R07（2025）\日本海商事・R07.xlsx"
destFile = "C:\Users\Owner\Desktop\転記用作業ファイル.xlsm"
sourceSheet1 = "R0704"
destSheet = "転記"
sourceRange1 = "D4:D34" 'とうもろこし
sourceRange2 = "K4:K34" 'ピーマン
sourceRange3 = "O4:O34" 'キャベツ
sourceRange4 = "C4:C34" 'レタス
sourceRange5 = "R4:R34" 'ナス
destRange0 = "B4:F34"
destRange1 = "B4"
destRange2 = "C4"
destRange3 = "D4"
destRange4 = "E4"
destRange5 = "F4"
' ソースファイル1を開く
Set wbSource1 = Workbooks.Open(sourceFile1)
' ソースファイル2を開く
Set wbSource2 = Workbooks.Open(sourceFile2)
' 転記先ファイルを開く
Set wbDest = Workbooks.Open(destFile)
' 転記先のデータを消す
wbDest.Sheets(destSheet).Range(destRange0).ClearContents
' ソースファイル1から転記
wbSource1.Sheets(sourceSheet1).Range(sourceRange1).Copy
wbDest.Sheets(destSheet).Range(destRange1).PasteSpecial Paste:=xlPasteValues
' ソースファイル2から転記
wbSource1.Sheets(sourceSheet1).Range(sourceRange2).Copy
wbDest.Sheets(destSheet).Range(destRange2).PasteSpecial Paste:=xlPasteValues
' ソースファイル3から転記
wbSource2.Sheets(sourceSheet1).Range(sourceRange3).Copy
wbDest.Sheets(destSheet).Range(destRange3).PasteSpecial Paste:=xlPasteValues
' ソースファイル4から転記
wbSource2.Sheets(sourceSheet1).Range(sourceRange4).Copy
wbDest.Sheets(destSheet).Range(destRange4).PasteSpecial Paste:=xlPasteValues
' ソースファイル5から転記
wbSource2.Sheets(sourceSheet1).Range(sourceRange5).Copy
wbDest.Sheets(destSheet).Range(destRange5).PasteSpecial Paste:=xlPasteValues
' コピーの点滅枠を解除
Application.CutCopyMode = False
wbDest.Sheets(destSheet).Range("B4").Select
' ファイルを保存して閉じる
wbDest.Save
wbSource1.Close SaveChanges:=False
wbSource2.Close SaveChanges:=False
'wbDest.Close SaveChanges:=True
' メモリを解放
Set wbSource1 = Nothing
Set wbSource2 = Nothing
Set wbDest = Nothing
MsgBox "転記が完了しました！"
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
>sourceFile1…M2の値
sourceFile1 = Worksheets("転記").Range("M2").Value
とかに変更したらどうでしょう。転記シートのM2ですよね。
同様にほかの変数も設定できると思います。
そういう話でなければ、具体的に困っていることを書いてください。
# プロシージャ名からすると、AIか何かが作ったコードですか? # それなら、引き続きそちらに質問したほうがよいと思いますよ。 （xyz） 2025/04/15(火) 19:09:11
最初から作り直してみました。
指定したシート名(J6)の値が参照してくれません。
下記のコードで止まります。 「インデックスが有効範囲にありません」のメッセージが表示されます。
Set ws1 = wb1.Sheets(sheetName) 'コピー元のファイル1のシートを指定
Set ws2 = wb2.Sheets(sheetName) 'コピー元のファイル2のシートを指定
ご教授お願い致します。
Sub 転記()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim filePath1 As String
Dim filePath2 As String
Dim sheetName As String
' 1＝ハイオク 2＝ガソリン 3＝灯油 4＝軽油 5＝重油
Dim sRange1 As String 'コピー元範囲1
Dim sRange2 As String 'コピー元範囲2
Dim sRange3 As String 'コピー元範囲3
Dim sRange4 As String 'コピー元範囲4
Dim sRange5 As String 'コピー元範囲5
Dim tRange1 As String 'コピー先セル1
Dim tRange2 As String 'コピー先セル2
Dim tRange3 As String 'コピー先セル3
Dim tRange4 As String 'コピー先セル4
Dim tRange5 As String 'コピー先セル5
' ファイルパスとシート名を取得
filePath1 = ThisWorkbook.Sheets("転記").Range("L2").Value
filePath2 = ThisWorkbook.Sheets("転記").Range("L3").Value
sheetName = ThisWorkbook.Sheets("転記").Range("J6").Value
' 別のブックを開く
Set wb1 = Workbooks.Open(filePath1) 'コピー元のファイル1
Set wb2 = Workbooks.Open(filePath2) 'コピー元のファイル2
' 参照するシートを設定
Set ws1 = wb1.Sheets(sheetName) 'コピー元のファイル1のシートを指定
Set ws2 = wb2.Sheets(sheetName) 'コピー元のファイル2のシートを指定
'コピー元範囲
sRange1 = "D4:D34"
sRange2 = "K4:K34"
sRange3 = "O4:O34"
sRange4 = "C4:C34"
sRange5 = "R4:R34"
'転記先セル
tRange1 = "B4"
tRange2 = "C4"
tRange3 = "D4"
tRange4 = "E4"
tRange5 = "F4"
'コピー先のデータをクリア
ThisWorkbook.Worksheets("転記").Range("B4:F34").ClearContents
' コピー元から転記する
' ソースファイル1から転記シートに転記
ws1.Range(sRange1).Copy
ThisWorkbook.Sheets("転記").Range(tRange1).PasteSpecial Paste:=xlPasteValues
' ソースファイル2から転記シートに転記
ws1.Range(sRange2).Copy
ThisWorkbook.Sheets("転記").Range(tRange2).PasteSpecial Paste:=xlPasteValues
' ソースファイル3から転記シートに転記
ws2.Range(sRange3).Copy
ThisWorkbook.Sheets("転記").Range(tRange3).PasteSpecial Paste:=xlPasteValues
' ソースファイル4から転記シートに転記
ws2.Range(sRange4).Copy
ThisWorkbook.Sheets("転記").Range(tRange4).PasteSpecial Paste:=xlPasteValues
' ソースファイル5から転記シートに転記
ws2.Range(sRange5).Copy
ThisWorkbook.Sheets("転記").Range(tRange5).PasteSpecial Paste:=xlPasteValues
' コピー元の点滅枠を解除する
Application.CutCopyMode = False
' 別のブックを閉じる
wb1.Close SaveChanges:=False
wb2.Close SaveChanges:=False
' メモリを解放
Set wb1 = Nothing
Set wb2 = Nothing
'セルの移動
ThisWorkbook.Sheets("転記").Range("B4").Select
MsgBox "転記が完了しました！"
End Sub
（はみご） 2025/04/17(木) 17:19:16
# コメントつかなかったですかあ
そのエラーは100％例外なく、実際にないシート名を指定したことが原因で起きるものです。
変数sheetnameの中身を確認する方法はご存じですか？
今回だけではなく、VBAを利用する以上、エラーは避けられません。 これは初心者もベテランもエラーが発生することでは同じです。（発生する箇所が違うかもしれませんが） デバッグ（間違いを見つけて修正すること）は誰にも求められる作業でコードを書くことと同程度に重要です。 結果を他人から聞いて切り抜けることよりも、 腰を据えて書籍でデバッグ手法の理解にじっくり取り組まれることをお薦めします。
ネット上であれば、"VBA デバッグのやり方"などで調べればいくつも参考になるものがあります。例えば、 https://www.excelspeedup.com/vbadebug/
（xyz） 2025/04/17(木) 20:01:16
あれから、いろいろ試行錯誤しながらなんとか作成できました。
ありがとうございました。
（はみご） 2025/04/28(月) 10:15:35
お疲れ様でした。いささかでも参考になったのであればよかったです。 （xyz） 2025/04/28(月) 12:25:27
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.