一番下の行に値貼り付けをする

1回目実行した時は2つのExceclがフォルダーにあった場合、1つ目のbookのデータの一番下の空行に2つ目のbookのデータが貼り付けされるのですが、2回目実行した時には1回目のデータに上書きされてしまうので、2回目以降のデータ貼り付けも一番下の空行に貼り付けていきたいのです。
どうしたらいいでしょうか。
ご教授お願いいたします。


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 2 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

No.1 ベストアンサー 回答者： fujillin 回答日時： 2017/10/20 13:11

こんにちは

通常であれば、ご提示の処理で順に次の行にペーストされてゆくと思います。

一方で、ご質問のような事象が起きる可能性の一つとして考えられるのは、ペ－ストしたデータの最初のセルの値（A2セルの値）が空白で、ペースト後のシートのA列が空白になっている場合でしょうか。

このようなデータが存在すると、
＞ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
では、空白セルは無視されてもう一つ上の行を取得して、その次の行を参照しますので、結局、同じ行にペーストするということが起こり得ます。

End(xlUp)を利用して最終行を取得する場合には、対象とする列に『必ず値が入っていることが保証されている』列を指定するのが原則です。

※ 他にも原因があるかも知れませんが、なんとなく上記の可能性が高いのではないかと思いましたので。（違っていたらスルーしてください）

この回答へのお礼

こんにちは
お返事いただきましてありがとうございます。
教えていただきましたこと、確認いたしました！
A列は日付を入力する列であり、空白は無しの原則でデータがありましたので、こちらは大丈夫でした。

そしてよく見てみると実行ボタンの内容に　Call　を使っており、その1つの　call　に入力しているデータの削除がありました！
これを走らせてから上記の内容を走らせていたので、上書きとなっておりました。

こちらの確認不足でお時間割いていただき申し訳ございませんでした。
ありがとうございました。

教えていただいたこと今後につなげていきます。

お礼日時：2017/10/21 04:55