指定したセルの下へ行を追加する

エクセルのＶＢＡを作成しています。
１．検索して一致した内容の隣（Ｂ列)のセルに色がつく２．色のついたセルの下へ1行空白行を追加する
をしたいと思い、
With Sheets(1)
If Not hkR Is Nothing Then
Set myR = Intersect(hkR.EntireRow, .Columns(2))
If Not myR Is Nothing Then
myR.Interior.ColorIndex = 18

myR.Offset(1).EntireRow.Insert , shift:=xlDown
Application.CutCopyMode = False
End If
End If
End With
Set myR = Nothing
Set scR = Nothing
Set ckR = Nothing
Set hkR = Nothing
End Sub


上記コードの、
myR.Offset(1).EntireRow.Insert , shift:=xlDown
Application.CutCopyMode = False
の部分が違うと思うのですが、
色のついたセルが２つ３つとつながって存在した場合
（２行目３行目４行目と言った感じに）
２行目の下にまとめて空白行が３行追加されてしまいます。

↓
２行目
空白行
３行目
空白行
４行目
空白行
としたいのですが、どのように直したらよいのかわかりません。申し訳ありませんがよろしくお願いします。

No.1 ベストアンサー 回答者： hana-hana3 回答日時： 2005/06/21 13:00

検索(find)メゾッドのオプションで　SearchDirection:=xlPrevious と指定するとどうでしょうか？

この回答へのお礼

ありがとうございました。
教えていただいてから、試行錯誤しながら
Ｆｉｎｄの　SearchDirection:=xlPrevious
調べたり、作ってみたり、とやっていたのですが、
いまだできず・・・
ＶＢＡ難しくてなかなか覚えられず・・・
引き続き挑戦してみます。ありがとうございました。

お礼日時：2005/06/23 22:07