エクセルVBAでのブック間ペーストができない

Question

前提・実現したいこと

エクセル（VBA）で集計表を作成しています。

デスクトップにある集計フォルダ内にあるエクセルファイル（.xlsx）の特定のセルをコピーしてマクロのあるブックにペーストをしたいです。

発生している問題・エラーメッセージ

実行時エラー'1004':
アプリケーション定義またはオブジェクト定義のエラーです。

該当のソースコード

Sub 集計()
  
'Application.ScreenUpdating = False
'ActiveSheet.Range("B3:B15") = ""        
    
Dim Filename    As String
Dim IsBookOpen  As Boolean
Dim OpenBook    As Workbook

With CreateObject("WScript.Shell")
    .CurrentDirectory = "C:\Desktop\集計\"
End With


Filename = Dir("*.xlsx")
     
Do While Filename <> "" 'フォルダ内のファイルをループ
    i = 1
    If IsBookOpen = False Then
                          
        Workbooks.Open (Filename), UpdateLinks:=1
            
        ActiveWorkbook.Worksheets("10月").Range("G1").Copy
        ThisWorkbook.Worksheets("10月").Activate
        Range(2, 3).PasteSpecial Paste:=xlPasteValues                 
        Workbooks(Filename).Close SaveChanges:=False 'True
                                   
    End If
    
i = i + 1
    
Filename = Dir()
    
Loop

End Sub

試したこと

おそらくペーストができていないので
18行目のペーストの特性やブック・シートの指定方法を変えましたが
開いたブックのコピーができた段階でエラーが出ます。

補足情報（FW/ツールのバージョンなど）

office365

Answer 1

Range(2, 3).PasteSpecial Paste:=xlPasteValues
ここでエラーになるのですよね。

Range("C2").PasteSpecial Paste:=xlPasteValues
とするか、
Cells(2,3).PasteSpecial Paste:=xlPasteValues
としてください。

---

蛇足ですが、使用していない変数があったり、無駄な処理が多いのが気になるので、リファクタリングしてみました。

Sub 集計()
    Dim Filename    As String
    Dim OpenBook    As Workbook
    Dim PasteCell As Range
    Set PasteCell = ThisWorkbook.Worksheets("10月").Cells(2, 3)

    Const FolderPath = "C:\Desktop\集計\"
    Filename = Dir(FolderPath & "*.xlsx")

    Do While Filename <> ""
        Set OpenBook = Workbooks.Open(FolderPath & Filename)
        
        PassteCell.Value = OpenBook.Worksheets("10月").Range("G1").Value
        OpenBook.Close SaveChanges:=False

        Set PasteCell = PasteCell.Offset(1) '次のセル
        Filename = Dir()
    Loop

End Sub

Comments

[roloc2909]

ありがとうございます、Cellsにしたらできました。
また、頂いたVBAでやったところ
Set OpenBook = Workbooks.Open(Filename)
でエラーが出ました・・

[hatena19]

あっ、コード間違ってました。
回答のコードを修正しました。

[roloc2909]

ありがとうございます。
ただ他の方のが今後の応用のイメージがわきやすかったのでベストは今回ごめんなさい。。。

Answer 2

オブジェクト定義のエラーです。

Rangeプロパティの引数の指定方法が間違っています。
つまり存在しないセルを指定しているということです。
Rangeプロパティは数字のみでは、セルを認識しません。
行番号、列番号で指定するのは、Cellsプロパティです。

↓参考サイト
Rangeプロパティ　

他にも

If IsBookOpen = False Then

変数「IsBookOpen」がTrueになりようがないし、
おかしな記述が多いです。
試行錯誤の中で消しちゃったのでしょうか？

Sub test()
    Dim buf As String
    Dim wb As Workbook
    Dim i As Long
    Const sDirPath As String = "C:\Desktop\集計*"


    buf = Dir(sDirPath & ".xlsx")
    Do While Len(buf) > 0
        'ファイルをすでに開いているか確認
        For Each wb In Workbooks
            If buf = wb.Name Then Exit For
        Next
        
        '開いてなければ開く
        If wb Is Nothing Then
            Set wb = Workbooks.Open(sDirPath & buf)
        End If

        'コピペ
        wb.Worksheets("10月").Range("G1").Copy
        ThisWorkbook.Worksheets("10月").Cells(i, 3).PasteSpecial xlPasteValues
        
        '開いたファイルを閉じる
        wb.Close False
        
        buf = Dir()     '次のファイル
        i = i + 1       '次の行番号
    Loop
End Sub

Comments

[roloc2909]

ありがとうございます、間違いを直したらできました。
まえあ、頂いたVBAでやったところ
Set wb = Workbooks.Open(sDirPath & buf)
で同じエラーが出てしまいました。

[mattuwan]

Const sDirPath As String = "C:\Users\hiraigumit\Desktop\集計\"

buf = Dir(sDirPath & "*.xlsx")

失礼しました。上に修正願います。

[roloc2909]

ありがとうございます。