データが入っているところまでをコピーして値貼り付けしたい

一部抜粋
Sheets("入力").Range("A2:AG500").Copy　
→ここが500行までになっているので、A列のデータが入っているところまでをコピーとしたいのです。ご教授くださいです。


Sub データ取り込み()
Dim buf As String, i As Long
Dim j
buf = Dir(Sheets("book保存場所").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("book保存場所").Range("A1").Value & "\" & buf
Sheets("入力").Range("A2:AG500").Copy　
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop

End Sub

質問者からの補足コメント

• コピー元データのA行には数式が入っており、見た目はブランクでも数式が入力されています。

    補足日時：2017/10/13 08:29

No.3 ベストアンサー 回答者： GooUserラック 回答日時： 2017/10/13 09:01

No.2 の訂正です。

タイトル行のようなものが有ったんですね。「For r = Sheets("入力").Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1」を「For r = Sheets("入力").Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1」に修正してください。申し訳ございません。

この回答へのお礼

迅速なご対応かつ、追加でスペース分も教えてくださりありがとうございます。
おかげ様で出来ました！！

パパッと出来ちゃうなんてすごいですね！！！
無理だと思いますが、色々教わりたい！！と思う次第です。

お礼日時：2017/10/13 10:12

No.2 回答者： GooUserラック 回答日時： 2017/10/13 08:58

こんなのはいかがでしょうか？

----------------------------------------------------------------------------------------------
Sub データ取り込み()
Dim buf As String, i As Long
Dim j
Dim r As Long
buf = Dir(Sheets("book保存場所").Range("A1").Value & "\*.xls")
Do While buf <> ""
Workbooks.Open Worksheets("book保存場所").Range("A1").Value & "\" & buf
For r = Sheets("入力").Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Sheets("入力").Cells(r, 1).Text <> "" Then Exit For
Next
Sheets("入力").Range("A2:AG" & r).Copy
ThisWorkbook.Activate
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks(buf).Activate
Application.CutCopyMode = False
Workbooks(buf).Close SaveChanges:=False
buf = Dir()
Loop
End Sub
----------------------------------------------------------------------------------------------
なお、スペースだけの物も除外したいのならば「If Sheets("入力").Cells(r, 1).Text <> "" Then Exit For」を「If Trim(Sheets("入力").Cells(r, 1).Text) <> "" Then Exit For」に変えてください。

No.1 回答者： GooUserラック 回答日時： 2017/10/13 07:11

「Sheets("入力").Range("A2:AG500").Copy」を「Sheets("入力").Range("A2:AG" & Sheets("入力").Cells(Rows.Count, 1).End(xlUp).Row).Copy」でいかがでしょうか？

また「Range("A65536").End(xlUp).Offset(1, 0).Select」は Excel2003 まではこれで良いのですが Excel2007 以降も対応させるならば「ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select」にしてください。

この回答へのお礼

ありがとうございます。また追加で教えていただき感謝しております。
早速試させていただいたのですが、コピー元のデータが500行まで数式が入ってるからなのでしょうか、やはり2つ目のExcelのデータは501行からコピーされます。
数式が入っていても値がある行だけコピーして値貼り付けすることは可能でしょうか。

お礼日時：2017/10/13 08:27