削除して空白になった行を下から詰めたい

質問

Ａ行には項目の名前があり、A列には番号が上から１，２，３・・と振られています。
そして、B2からR999までにはそれぞれデータが入っています。
このとき、任意のＲ列のセルを選択したまま、マクロを実行すれば、
任意の行のB列からR行が削除されて、下から上に詰めるように（空白にならないように）
するマクロを作りたいです。（Ａ行に割り振っている番号を消してしまうと
連番が崩れるので、B列からR列までを詰めていくような感じです）

例：　今、R11のセルを選択しています。希望のマクロを実行すると、C11～R１１が削除されて
　　　C12以降のデータが丁度上に移行するような感じです。

どのようなコードを作れば良いのか、お力をかしていただければ幸いです(/_;)

回答No.3

mt2008 · ベストアンサー

> 罫線や背景色もすべて消えてしまいました。文字だけを消す方法はあるでしょうか。。
「削除」ってそういうものなんですけどね。
これはどうかな

Sub test()
　　Dim nRow
　　nRow = Selection.Row
　　If nRow < 999 Then
　　　　Range("B" & nRow & ":R998") = Range("B" & nRow + 1 & ":R999").Value
　　End If
　　Range("B999:R999").ClearContents
End Sub

お礼

ありがとうございます！
ばっちり動きました。早くお答えいただき本当に助かりました！

回答No.2

keithin

複数のセルを同時に選択していても作動します。

sub macro1
application.intersect(range("B:R"), selection.entirerow).delete shift:=xlshiftup
end sub

お礼

ありがとうございます！
びっくりしました(・・;)こんな短い間で色々と要望以上のことができてしまって・・
でも本当に本当に申し訳ないです；
nao-yさんと同じようにやはり罫線や背景色が消えてしまって戸惑っています；
私の説明不足です。本来なら新たに質問をやり直すべきなのですが皆さんの貴重な
ご回答をいただいたので、もしわかるようであればおしえていただければ幸いです；

回答No.1

nao-y

このコードでいけると思います。
お試しください。

Sub example()
Dim myRow As String
myRow = Selection.Row
Range("B" & myRow & ":R" & myRow).Delete shift:=xlUp
End Sub

お礼

ありがとうございます！しかし、このマクロを実行すると、セルそのものが消えてしまい、
罫線や背景色もすべて消えてしまいました。文字だけを消す方法はあるでしょうか。。
あとB1～R999のセル以外はロックをして選択できないようになっています。ロックを解除
すると上記マクロは実行できるのですがロックをするとエラーが出てしまいました(;_;)
そこまで質問の中に書いていなかったので説明分不足でした。大変失礼しました。
もしわかるようであれば教えていただければすごく助かります；