複数のファイルのsheet1だけをまとめるには

質問

sub UsedRangeをOffsetする()
Dim rng先 As Range
Dim PathMacrobook As String
Dim Name元book As String
Dim 元Book As Workbook
Dim 元Sheet As Worksheet

Set rng先 = Workbooks("BOOKALL.xls").Worksheets(1).Range("A2")
PathMacrobook = ThisWorkbook.Path & "\"
Name元book = Dir(PathMacrobook & "*.xls")
Do While Not Name元book = ""
If Name元book = ThisWorkbook.Name Then
ElseIf Name元book = "BOOKALL.xls" Then
Else
Set 元Book = Workbooks.Open(PathMacrobook & Name元book)
For Each 元Sheet In 元Book.Worksheets
With 元Sheet.UsedRange
.Offset(1).Copy rng先
Set rng先 = rng先.Offset(.Rows.Count - 1, 0)
End With
Next
元Book.Close False
End If
Name元book = Dir()
Loop
End Sub
このコードではフォルダにあるブックのすべてのシートをBOOKALLのシート1に
上書きコピーしてしまう事がわかりました。

やりたい事
オープンするブックのsheet1だけを、.end(xlup)を使って一覧にしたいです。。
どの様にしたらよいでしょうか？

回答No.1

onlyrom · ベストアンサー

＞このコードではフォルダにあるブックのすべてのシートを、、

-----------------------------------------------------
▲削除▲　For Each 元Sheet In 元Book.Worksheets

●挿入●　Set 元Sheet = 元Book.Worksheets("Sheet1")

　　　With 元Sheet.UsedRange
　　　　.Offset(1).Copy rng先
　　　　Set rng先 = rng先.Offset(.Rows.Count - 1, 0)
　　　End With

▲削除▲　Next
------------------------------------------------

上記のコードで、
▲のFor、Nextを削除して、●のSetを入れる

お礼

ありがとうございました。
うまくいきました！！