VBAの５つExcelファイルを１つにまとめるフォルダでエラーが出ます。

Question

VBAの質問です。
同じフォルダにあるExcel５つを同じExcelsheetにまとめるマクロを作ろうと思っています。
しかし、実行してもエラーになります。
どこが悪いのでしょうか？

Sub ファイル読み込み()

Dim wb As Workbook
Dim i As Integer
Dim a As Integer
Dim Filename    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook


With CreateObject("WScript.Shell")
    
    .currentDirectory = "フォルダ場所"

End With


Filename = Dir("*.xlsx")
        Set wb = Workbooks.Open(Filename:=Filename, UpdateLinks:=3, ReadOnly:=True)
        
    ThisWorkbook.Sheets("グラフ作成").Range("B2:B7").Value = wb.Sheets("sheet1").Range("B2:B7").Value
    wb.Close savechanges:=falese
    
Do While Filename <> ""

        Set wb = Workbooks.Open(Filename:=Filename, UpdateLinks:=3, ReadOnly:=True)
        
        
        For i = 3 To 5
            ThisWorkbook.Sheets("グラフ作成").Range(Cells(2, i), Cells(7, i)).Value = wb.Sheets("sheet1").Range("C2:C7").Value
        Next i
        
    wb.Close savechanges:=falese


Loop
    wb.Close savechanges:=falese

End Sub

Comments

[jinoji]

多分エラーの原因ではないと思いますが、faleseはFalseのスペルミスですね。

[JetSzero]

ご指摘ありがとうございます。
エラーの原因は分かりませんか？

Answer 1

参考までに動画　URL　載せます
https://www.youtube.com/watch?v=Y1qwbvXpAuA
https://www.youtube.com/watch?v=XkZPo6GEwtM&t=49s

Answer 2

頭にシート名をつけずにCellsとかRangeとかを使うと、ActiveSheetが省略されたとみなされるので、
複数のシートを扱う場合思わぬエラーの原因になります。

ファイルをOpenするとそれがActiveWorkbookになるので、
いまエラーが起きている箇所でThisWorkbook.Sheets("グラフ作成")の中のセルを指定しているつもりのところが、別のシートを指定することになってしまい、エラーになったのでしょう。
たとえば以下のように直したらうまくいく気がします。

Dim ws As Worksheet
set ws = ThisWorkbook.Sheets("グラフ作成")
'（略）
ws.Range(ws.Cells(2, i), ws.Cells(7, i)).Value = wb.Sheets("sheet1").Range("C2:C7").Value
'（略）

Comments

[JetSzero]

エラーはなくなって3列目まではデータが入力されるようになったのですが、残り2列分が表示されません。
また、実行が永遠と続いて終了しません。
原因分かりますか？
何度もすみません。

[jinoji]

ループの最後に次のファイルを読み込まないからでは？
Filename = Dir()

[jinoji]

グラフ作成シートの C2:C7、D2:D7、E2:E7 のそれぞれに sheet1のC2:C7をセットするというのがやりたいことですか？

[jinoji]

なんかファイルを開くたびに同じシートの同じセルに転記してしまうように思えるのですが。