【VBA】条件分岐について

質問

当方Excel2003です。
○フォルダ内に入力用のブック（複数）とまとめ用ブック（一つ）が存在し
○すべてのブックにはシートが一つしかなく、タイトル行の位置はまとめブック含めすべて同じ構成である
○入力用ブックのシート名は「入力」、まとめ用ブックのシート名は「まとめ」である
前提で、入力用ブックのデータ入力域をまとめ用ブックに順次コピーをしようと作成中のものですが、
入力用のファイルにデータがきちんと入力域（B7～T７、以降B8～T8…と続きます）に入っているファイルでは問題ありませんが、
データの入力がなくタイトル行のみしかないファイルの場合、タイトル行を最終行と認識し、タイトル行を張り付けてしまいます。

上記のケースの場合、
Select Case ～End Selectの間に、さらに条件（データがなければ、あるいはタイトル行のみの場合はなにもせず次のファイルへ…）を足すのを考えたのですがどういうふうに変更したら良いのか
どなたかご教示いただければ幸いです。
よろしくお願いいたします。

ちなみにA列は６行目までタイトル行で、A７から下に1,2,3…と番号を入力していますが、コピーの対象範囲外としています。

Sub 連続貼り付け()
Dim sFile As String
Dim c As Range
Dim myPAth As String

Application.ScreenUpdating = False

sFile = Dir(ThisWorkbook.Path & "\*.xls", vbNormal)

myPAth = ThisWorkbook.Path

Do While 0 < Len(sFile)
　　　　　With ThisWorkbook.Worksheets("まとめ")
　　　　　　Set c = .Range("B" & .Rows.Count).End(xlUp).Offset(1)
　　　　　End With

　　　 Select Case sFile
　　　　　　　Case ThisWorkbook.Name:
　　　　　　　Case Else
　　　　　　　　　With Workbooks.Open(Filename:=myPAth & "\" & sFile, ReadOnly:=True)
　　　　　　　　　　　　　With .Worksheets(入力)
　　　　　　　　　　　　　　　　.Range("B7", .Range("T" & .Rows.Count).End(xlUp)).Copy
　　　　　　　　　　 　　　　　　　　 c.PasteSpecial xlPasteValues
　　　　　　　　　　　　　End With
　　　　　　　　　　　　.Close SaveChanges:=False
　　　　　　　　　End With

　　　　　End Select

　　　　　sFile = Dir()
　　　　　Set c = Nothing
　　Loop

　　Application.ScreenUpdating = True

　　End Sub

回答No.1

keithin

入力シートの最下行＞タイトル行ならコピーする，というだけのことで。

作成例：

sub macro1()
　dim myFile as string
　dim myPath as string
　dim c as range
　dim r as long

　mypath = thisworkbook.path & "\"
　myfile = dir(mypath & "*.xls")

　do until myfile = ""
　　set c = thisworkbook.worksheets("まとめ").range("B65536").end(xlup).offset(1)
　　if myfile <> thisworkbook.name then
　　　with workbooks.open(filename:=mypath & myfile, readonly:=true)
　　　　r = .worksheets("入力").range("B65536").row
　　　　if r > 6 then
　　　　　.worksheets("入力").range("B7:T" & r).copy destination:=c
　　　　end if
　　　　.close savechanges:=false
　　　end with
　　end if
　　myfile = dir()
　loop
end sub