VBA 項目行より下のデータがない場合はデータの取り込みなしにしたい

以下のコードですと、取込み元のデータの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("DB").Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Sheets("DB").Cells(r, 1).Text <> "" Then Exit For
Next
Sheets("DB").Range("A2:I" & 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.2 ベストアンサー 回答者： fujillin 回答日時： 2018/02/15 13:05

こんにちは

コードだけからではちょっとデータの状態が読み取れないのですが・・・

＞Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Row
通常、この処理では、A列の空白でない最大行の行数が取得できます。
（A列の最終行のセル(1048756行など)が空白の場合に限りますが、まぁ大抵は空白ですので…）

1行目は必ずタイトルが記されていると仮定でき、さらに、A列に値があるかないかだけで判断して良いのなら、上記の行数が2以上ならコピー、1ならばタイトル行のみと判断してコピーしないなどでよさそうな気がします。
もしも、A列のデータが飛び飛びで（途中に空白行が混ざっている）データのある行だけを詰めてコピーしたいという意図の場合は、途中の空白行を除く処理が必要になりそうです。

さて、ご提示のコードでは
＞For r = Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
＞If Sheets("DB").Cells(r, 1).Text <> "" Then Exit For
＞Next
となっていますが、この処理をよく追いかけてみてください。

最終行から2行目までのループで、A列の値が空白でなければループを抜ける（ｒにその行が保持される）
ということですが、いろいろと問題がありそうです。
1）そもそもになってしまいますが、End(xlUp).Rowで取得した行は「値がある最大行」のはずなので、このループでどのような処理を期待しているのかがよくわかりません。（普通は、1回目で抜けるので何もしないのと同じ）
2）仮に条件判定でループが続くとして（このケースはないと思いますが）、2行目までに非空白行が見つかれば、その行がrに保持されますが、見つからなった場合はどうなりますか？
（変数ｒに1が保持されてループを抜けてきます）
3）もともと最終行を取得しているので、最終行が1の場合（＝タイトル行しかない場合）には、ループの処理は行われないので、rの値はループの初期値（=1)となって抜けてきます。（Forの条件判定と実行については後述）

想像するところ、2）や3）のr=1の際には、コピー処理をスキップしたいのではないかと思いますが、ご提示のコードではr=1の値を保持しているので、A2：I1の範囲がコピーされるようになっています。
この結果、
＞取込み元のデータの2行目以下のデータがない場合、
＞項目行の1行目と2行目（空行）が取りこまれます。
のような処理になっているものと考えられます。

・・・で、どうすればよいかと言えば、最終行を取得してそれが2以上ならコピー、それ以外はスキップとすれば良さそうに思えますが、そういうことではないのでしょうか？

r = Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Row
If r>1 Then
　'
　'ここにコピーの処理を入れる
　'
End If
（前述のような途中の空白行を除きたいという場合は、別に処理が必要となります）


＜おまけ＞
ご提示のコードでは、暗黙の指定（ActiveWorkbookやActiveSheet）を利用した書き方となっていますが、単一ブックや単一シートでの作業では問題ありませんが、ご提示の処理のように、複数のブックやシートを扱う場合は、なるべくブックやシートを明示する記述方法にしておく方が、勘違いや間違いの原因を減らすことにつながると思います。
例えばセルを指定する典型的な記述方法として
　Workbook.Worksheet.Range("～～")
といった具合です。

繰り返し利用する値は、一旦変数に保持しておくとコードが簡潔になり、見やすくなることが多いです。
例えばフォルダアドレスを変数に入れておけば、文字列連結処理を複数回させなくても済みます。
あるいは、コピー先の最終行を毎回取得する処理を行っていますが、Rangeオブジェクトとして保持しておいて、記入する毎にその行数を進めるような処理を行うようにする（記入先のポインタとする）などで、コピーの処理の記述も単純化できると思います。
Rangeオブジェクトではなく、「次に記入する行」を変数に入れておいても良いかも。
オブジェクトでの記述例として
　Worksheets("DB").Range("A2:I" & r).Copy
　destRange.PasteSpecial Paste:=xlPasteValues
　Set destRange = destRange.Offset(r)
のような感じです。

変数を活用することで、ActivateやSelect、Selectionといった記述を無くしたコードにすることが可能です。
そうすることによって、処理速度の向上や画面のチラつき等を防ぐことに役立ちます。
（コードの簡明化も図れると思います）

他の方の回答で、Forループは必ず1回実行されるとありますが、Doループ等の場合はそのようなループを作成できますが、Forループでは条件が合わない場合は実行されません。
例えば
　r = 5
　For r = 8 To 10 Step -1
　　MsgBox r
　Next
を実行してみると、（条件に合わないので）ループ内の処理が実行されることはありませんが、変数ｒの値はループの初期値の8に変わります。

この回答へのお礼

詳しく教えていただきましてありがとうございました。
体調を崩しましてお返事とお礼が遅くなり申し訳ございません。
少し復活しましたので内容を熟読したいと思います。
またわからないことが出ましたら教えていただけますと幸いです。

お礼日時：2018/02/19 04:45

No.1 回答者： t_fumiaki 回答日時： 2018/02/15 07:25

for分は実行した後にloop変数をカウント・評価するので、1回は実行されてしまいます。

この点の注意が要ります。

if Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Row>1 then ←追加

For r = Sheets("DB").Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

If Sheets("DB").Cells(r, 1).Text <> "" Then Exit For
Next

endif←追加

この回答へのお礼

早速お返事ありがとうございます。
この後体調を崩しましてお返事とお礼が遅くまり申し訳ございませんでした。
上記のコードを実際に試してみたいと思います。
またわからないことが出ましたら教えていただけますと幸いです。

お礼日時：2018/02/19 04:46