3個のfileのセルデータを1個のfileのセルに貼り付けるVBAコードですが。

E:\01 65-66まで繰下げと従業員\01-2022-61にあるファイル名2022-61
E:\01 65-66まで繰下げと従業員\01-2023-62にあるファイル名2023-62
E:\01 65-66まで繰下げと従業員\02-2024-63にあるファイル名2024-63
ファイル名2022-61のシート名202261のcells(58,4)
ファイル名2023-62のシート名202362のcells(54,4)
ファイル名2024-63のシート名202463のcells(55,4)
これら３個のファイルの各々のセル値を
c:users\toshihiro\Desktop\VBA100\616263にあるファイル名616263
に貼り付けたいです。具体的には
2022-61のシート名202261のcells(58,4)数値を616263のcells(2,1)に
2023-62のシート名202362のcells(54.4)数値を616263のcells(2.2)に
2024-63のシート名202463のcells(55,4)数値を616263のcells(2,3)に
それぞれ貼り付けるVBAコード次項に表記します。
結果
Sub CopyValuesToMaster()

Dim masterFile As Workbook
Dim dataFile1 As Workbook
Dim dataFile2 As Workbook
Dim dataFile3 As Workbook
Dim masterFilePath As String
Dim dataFilePath1 As String
Dim dataFilePath2 As String
Dim dataFilePath3 As String


masterFilePath = "C:\Users\toshihiro\Desktop\VBA100\616263.xlsx"
Set masterFile = Workbooks.Open(masterFilePath)


dataFilePath1 = "E:\01 65-66まで繰下げと従業員\01-2022-61\2022-61.xlsx"
Set dataFile1 = Workbooks.Open(dataFilePath1)
Set datasheet1 = dataFile1.Sheets("202261")


dataFilePath2 = "E:\01 65-66まで繰下げと従業員\01-2023-62\2023-62.xlsx"
Set dataFile2 = Workbooks.Open(dataFilePath2)
Set datasheet2 = dataFile2.Sheets("202362")


dataFilePath3 = "E:\01 65-66まで繰下げと従業員\02-2024-63\2024-63.xlsx"
Set dataFile3 = Workbooks.Open(dataFilePath3)
Set datasheet3 = dataFile3.Sheets("202463")


masterFile.Sheets("Sheet1").Cells(2, 1).Value = datasheet1.Cells(58, 4).Value
masterFile.Sheets("Sheet1").Cells(2, 2).Value = datasheet2.Cells(54, 4).Value
masterFile.Sheets("Sheet1").Cells(2, 3).Value = datasheet3.Cells(55, 4).Value

dataFile1.Close SaveChanges:=False
dataFile2.Close SaveChanges:=False
dataFile3.Close SaveChanges:=False
masterFile.Save
masterFile.Close

End Sub

と出来たのですが、赤✖４００となりエラーなのです、修正箇所と
修正後の完成VＢＡコードをお教えください。
2022-61，2023-62，2024-63これらファイルは、外付けUSBメモリに保存されていて、616263ファイルはパソコンのデスクトップに保存されています。
どうかよろしくお願いいたします

No.1 ベストアンサー 回答者： PauloCoelho 回答日時： 2023/02/20 13:43

エラーの原因は、datasheet2をdataSheet2と誤ってスペルミスしているためです。

修正するには、以下のようにdataSheet2に変更する必要があります。


Set dataFile2 = Workbooks.Open(dataFilePath2)
Set dataSheet2 = dataFile2.Sheets("202362")


修正後の完成VBAコードは以下のようになります。Sub CopyValuesToMaster()
Dim masterFile As Workbook
Dim dataFile1 As Workbook
Dim dataFile2 As Workbook
Dim dataFile3 As Workbook
Dim masterFilePath As String
Dim dataFilePath1 As String
Dim dataFilePath2 As String
Dim dataFilePath3 As String
Dim dataSheet1 As Worksheet
Dim dataSheet2 As Worksheet
Dim dataSheet3 As Worksheet

masterFilePath = "C:\Users\toshihiro\Desktop\VBA100\616263.xlsx"
Set masterFile = Workbooks.Open(masterFilePath)

dataFilePath1 = "E:\01 65-66まで繰下げと従業員\01-2022-61\2022-61.xlsx"
Set dataFile1 = Workbooks.Open(dataFilePath1)
Set dataSheet1 = dataFile1.Sheets("202261")

dataFilePath2 = "E:\01 65-66まで繰下げと従業員\01-2023-62\2023-62.xlsx"
Set dataFile2 = Workbooks.Open(dataFilePath2)
Set dataSheet2 = dataFile2.Sheets("202362")

dataFilePath3 = "E:\01 65-66まで繰下げと従業員\02-2024-63\2024-63.xlsx"
Set dataFile3 = Workbooks.Open(dataFilePath3)
Set dataSheet3 = dataFile3.Sheets("202463")

masterFile.Sheets("Sheet1").Cells(2, 1).Value = dataSheet1.Cells(58, 4).Value
masterFile.Sheets("Sheet1").Cells(2, 2).Value = dataSheet2.Cells(54, 4).Value
masterFile.Sheets("Sheet1").Cells(2, 3).Value = dataSheet3.Cells(55, 4).Value

dataFile1.Close SaveChanges:=False
dataFile2.Close SaveChanges:=False
dataFile3.Close SaveChanges:=False
masterFile.Save
masterFile.Close
End Sub


修正後はエラーが発生せず、正常に実行されるはずです。注意点としては、外付けUSBメモリに保存されているファイルを開いた場合、VBAが正常に動作しないことがあるため、パソコンのローカルドライブにファイルをコピーしてから実行することをお勧めします。また、パスが間違っている場合やファイル名が異なる場合も、エラーが発生することがあるため、確認してから実行してください。

この回答へのお礼

ありがとうございます。
どこがいけないんだ。まだ同じエラーが出ます。教えてください。

お礼日時：2023/02/20 14:29