指定ファイルの複数シートを別のファイルへ転記したい

Question

前提・実現したいこと

初心者です。
複数シートに記入されているデータを、別の集計ファイルのシートへ一覧表としてデータ転記したいと考えています。
できれば今後、転記元のファイルは閉じて「転記完了しました」のメッセージ表示までしたいと思っています。
他にもおかしい箇所があるかもしれませんがかなり苦戦しています。
質問箇所以外にエラーのもとがあるようでしたら、ご教授頂ければ幸いです。

■実現したいこと■
転記元の月ごとのシートのデータを別の集計ファイル（転記先）へデータを転記する。
0. 転記元の各シートの3行目～データ最終行までをコピー
0. 集計シート（転記先）へシート順に転記
0. 最終シートを転記し終わったら転記元のエクセルを閉じる
0. 「転記完了しました」のメッセージ表示

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

マクロを実行するとまず、コード22行目： From_Max_Row = w.Range("B" & Rows.Count).End(xlUp).Row で
デバックとなります。

エラーメッセージ

> 424　オブジェクトが必要です

該当のソースコード

Sub リストを集約する()
    Dim wstData As Worksheet    '「Data」用オブジェクト変数
    Dim wstAnsw As Worksheet    '各回答用オブジェクト変数

    Dim lngWRow As Long         '「Data」への書込行
    Dim lngRRow As Long         '各回答リストアップ部読込行
    
    Dim r As Long

    'ファイルを開くダイアログを表示
    OpenFileName = Application.GetOpenFilename("Excelファイル,*.xls*")

    'キャンセル時の処理
    If OpenFileName = "False" Then
        'メッセージ表示
     MsgBox "キャンセルされました。処理を終了します。"
     End
    Else
          Workbooks.Open OpenFileName
    End If


    Set wstData = Workbooks("リスト集計.xlsm").Sheets("Date")
    
    '「Data」シート初期化
    With wstData
        .Rows("3:" & .Rows.Count).ClearContents
    End With
    
    lngWRow = 3     '初期化に伴い書込行も3へリセット
    
      'すべてのワークシートを繰り返し処理
       For Each wstAnsw In Worksheets
        With wstAnsw
            If .Name <> "使用方法" & "リスト" Then

    　　　  'コピーする各シートのデータで最も下にあるデータの行を探す（B列にデータがあることが前提）
            Dim From_Max_Row As Long
                From_Max_Row = w.Range("B" & Rows.Count).End(xlUp).Row  
          
            '貼り付け先のシート「Date」で最も下にあるデータの行を探す
            Dim To_Max_Row As Long
            To_Max_Row = ThisWorkbook.Sheets("Date").Range("B" & Rows.Count).End(xlUp).Row
                      
           '各シートのデータを3行目からすべてコピーし、「Date」に貼り付けていく
           w.Rows("3:" & From_Max_Row).Copy ThisWorkbook.Sheets("Date").Range("A" & To_Max_Row + 1)
           
             End If
    
       End With
      
      Next
      
End Sub

Answer 1

w.Rangeでなく.Range では？

Comments

[tororoko]

ありがとうございます。
.Range に修正したら動きましたが今度は以下のエラーメッセージが表示されました。

エラーメッセージ：1004　RangeクラスのCopyメソッド失敗しました
デバックのフォーカス部分は以下です。
　.Rows("3:" & From_Max_Row).Copy ThisWorkbook.Sheets("Date").Range("A" & To_Max_Row + 1)

コピーする範囲が広すぎるのでしょうか？
転記元のシートにはA：R列まで項目があるので、列だけでも指定するほうがいいのでしょうか？

[tororoko]

上記のエラーについては、以下のコード入力で回避できました。

'シート名が空欄の場合、読み取りを終了
ElseIf .Cells(r, 3) = "" Then

[jinoji]

If .Name <> "使用方法" & "リスト" Then は
If .Name <> "使用方法リスト" Then という意味になってしまいます。
そのため、意図しないシート（使用方法、リスト）も処理されているのではないでしょうか。

正しくは、If .Name <> "使用方法" And .Name <> "リスト" Then だと思います。

[tororoko]

ありがとうございます。
仰るとおり省きたいシートも処理されていました。
ご教示いただいたコードで、必要なシートのみが表示されるようになりました。

あと今回は最終行の下に続けて転記するのですが、最終行は転記しないようにしたい場合は
以下のコードでいいのでしょうか？
w.Rows("3:" & From_Max_Row ).Copy ThisWorkbook.Sheets("Date").Range("A" & To_Max_Row )

[jinoji]

コピー元の各シートの3行目から最終行の一つ手前までを、コピー先の最終行の下に転記する、という意味ですか？

[tororoko]

その通りです。

[jinoji]

でしたら、
コピー元の3行目から最終行の一つ手前まで ⇒ w.Rows("3:" & From_Max_Row - 1)
コピー先の最終行の下 ⇒ ThisWorkbook.Sheets("Date").Range("A" & To_Max_Row + 1)
じゃないですか？

w.Rows("3:" & From_Max_Row - 1).Copy ThisWorkbook.Sheets("Date").Range("A" & To_Max_Row + 1)