複数ファイルのシートを1つにまとめるVBAがうまくいきません。

フォルダ内に同一フォームで行数が異なる複数のファイルがあります。(20個)データがあるのは、sheet1だけです。それぞれのファイルのシートのタイトル行以下を新規ブックの1シートにまとめるため、同じ事をしたい方の質問の答えにあった以下のマクロを実行しましたが、RR.Copy Dst の部分で、次のようなエラーになってしまいます。エラーになったあとは、エクセルが固まりタスクの終了にしなければいけない状態です。新規ブックに一つ目のファイルのシートのデータはペイストされていますが、そこでディバックになります。VBAは初心者なので、解決策をどなたか教えていただけないでしょうか？

実行時エラー '-2147417848 (80010108)':
copyメソッドが失敗しました。rangeクラス.




Sub test()
'このブックと同一フォルダ内のブックの、１シート目の３行目以下を、 '新規ブックの１シートにまとめる
Dim Book As Workbook
Dim Fpath As String
Dim Fname As String
Dim RR As Range
Dim Dst As Range Fpath = ThisWorkbook.Path & "\" Fname = Dir(Fpath & "*.xls")
Application.ScreenUpdating = False
Do Until
Fname = "" If LCase(Fname) = LCase(ThisWorkbook.Name) Then
Else
If Dst Is Nothing Then
Set Dst = Workbooks.Add.Worksheets(1).Range("A1")
End If
Set Book = Workbooks.Open(Fpath & Fname) Set RR = Book.Worksheets(1).UsedRange
Set RR = Intersect(RR, RR.Offset(2))
RR.Copy Dst
Set Dst = Dst.Offset(RR.Rows.Count) Book.
Close False
End If
Fname = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "完了！" End Sub

No.1 回答者： WindFaller 回答日時： 2015/08/13 11:02

こんにちは。

初心者？　これを書いた人は、相当に頭の良い方だろうけれども、私のような、何年も同じようなレールに則った書き方しか出来ない人間（その上、劣化していっています)には、そのちょっとの所が、VBAの標準の軌道から外れているように思います。

むろん、試してみましたが、特にエラーは発生しませんでした。
私が気になる部分：

Set Dst = Workbooks.Add.Worksheets(1).Range("A1")
こういう書き方はあるものの、新規作成の場合は、ブック・シート・セルのオブジェクトは、分けたほうがよいし、そもそもRange型で保有する必要はないように思います。

Set RR = Book.Worksheets(1).UsedRange
Set RR = Intersect(RR, RR.Offset(2))
ここは、確実かどうかです。データの取得に、UsedRangeというのは、かなり無茶です。
それに、そこから、Intersect で、二行下からのデータを取得というところにも、多少の不安を感じます。

Set Dst = Dst.Offset(RR.Rows.Count)
そして、上記のRRの生成と連動してくると思います。