| 
    
     |  | 氷室と申します、 前回「特定文字間の列の非表示について 」
 では多くの回答どうもありがとうございました。
 
 再び未解決な部分が出来てしまったので
 質問させていただきます。
 
 
 シートを2枚持つExcelがあります。(下図)
 
 (Sheet1)
 --------------------
 項目1  | 項目2   ・・・・
 --------------------
 A氏    |AAAAA軍
 B氏    |AAAAA軍
 (Null)   |(Null)
 D氏    |DDDDDDD軍
 (Null)   |(Null)   ←★1
 F氏    |FFFFFF軍
 G氏    |FFFFFF軍
 H氏    |FFFFFF軍
 (Null)   |(Null)
 (Null)   |(Null)   ←★2
 -------------------
 
 (Sheet2)
 --------------------
 項目1  | 項目2   ・・・・
 --------------------
 |
 -------------------
 
 シート1は項目1と項目2の2つがあります。
 (他にも数十列項目はあるのですが、ここでは2項目で話ます。)
 
 シート1に(Null)があるのは空白行です。
 項目2で同じグループ分けしているものを見やすくするために
 一行Null行が入っています。
 ※一行以上空いた下にデータが入ることは無しとします。
 つまり、2行空白行が出来た場合にはそこが終端と考えます。
 
 シート2は始め、何も書かれていません。
 
 処理はシート1からをシート2にコピーします。
 コピーする部分はできていて、問題なく動作します。
 現状ではコピーする時に、空白行があると
 その時点で処理を終了する仕様になっていました。
 これを、2行連続して空白が出来た場合に処理を終了したいのです。
 
 そこで、
 空白行ができるとカウントし、
 2行になったら終わる様にしようと考えたのですが
 そうすると、Sheet1の図で★1の部分で終了してしまいます。
 希望としては★2の部分までコピーしたいです。
 
 途中の空白行はそのままシート2にもコピーします。
 
 コードは以下です。
 単純に空白だったらカウントしているだけなので
 ★1でループから抜けてしまうと思うのですが、
 cntNAME >= 1だと、1行空白があるだけで抜けるので
 現状と変わりません。
 
 連続する2つの行が空白だった場合に処理を終了する。
 という作りにしたいのでどなたかよろしくお願いします。
 
 (コード)
 -----------------
 dim cntNAME as integer
 
 Do While Not cntNAME >= 2
 If Sheet1.Cells(intRow, 3) = "" Then '空白かどうかチェック。
 cntNAME = cntNAME + 1       '空白であればカウント。
 End If
 ★コピーする処理。(1行ずつコピー)
 Loop
 -----------------
 
 |  |