VBAの連番の振り方について

質問

セルC1からC10まで罫線の表があり、inputboxで入力された数値だけD列以降にコピペされ、
セルC1をスタートに　C1が1、D1が2、E1が3・・・といったように、連番を振りたいのですが、
下記プログラムで実行すると、inputboxで入力された数値分、表はコピペされますが、
肝心な連番が振られず1行目は空白のままになってしまいます。

------------------------------------------------------------------------------
Dim cp As Long, x As Integer
Dim ren As Integer

答え1 = InputBox("拠点数を入力してください。", "拠点数入力")
ia = Val(答え1)

Application.ScreenUpdating = False
Range("C1:C10").Copy

For cp = 1 To ia - 1
Cells(1, x + 4).PasteSpecial
x = x + 1
Next

With Application
.CutCopyMode = False
.ScreenUpdating = True

End With

ren = 1
Range("C1").Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ActiveCell.Value = ren
ren = ren + 1
ActiveCell.Offset(1).MergeArea.Select
Loop

どう修正すれば良いのか分かりません。
宜しくお願い致します。

回答No.1

kkkkkm · ベストアンサー

もともとC1に何かデータが入ってなければ1行目は空白ですから
Do While ActiveCell.Offset(0, 1).Value <> ""
右横のセルをチェックしてますから、Loopは実行されません。

下(2行目)のセルが空白かどうかをチェックして
以下のようにするか
(ActiveCell.Offset(1).MergeArea.Selectは下方向に進むので変更しました)

Do While ActiveCell.Offset(1, 0).Value <> ""
ActiveCell.Value = ren
ren = ren + 1
ActiveCell.Offset(0, 1).MergeArea.Select
Loop

ActiveCellはやめたほうがいいのではと思いますから

Do While Range("C1").Offset(1, ren - 1).Value <> ""
Range("C1").Offset(0, ren - 1).Value = ren
ren = ren + 1
Loop

のようにするか

最後のren = 1以降はなくして(Do Whileはやめて)

最初のループを利用する以下に変更したらいかがでしょう。

Range("C1:C10").Copy
Range("C1").Value = 1
For cp = 1 To ia - 1
Cells(1, cp + 3).PasteSpecial
Cells(1, cp + 3).Value = cp + 1
Next

お礼

kkkkkmさん、ありがとうございました。
思っていた動きが出来るようになりました。
こんなにすっきりとした式で可能になるとは驚いた半面、
まだまだ勉強が必要だと再認識しました。
とてもいい勉強になりました。本当にありがとうございました。

回答No.2

kkkkkm

No.1の追加です。

連番だけ別にしたいのでしたら
Do Whileじゃなくて、Do Whileのところを
以下のようにしてはいかがでしょう。Do～Loopは極力使いたくない。

For i = 1 To ia
Range("C1").Offset(0, i - 1).Value = i
Next

代入部分は
Cells(1, i + 2).Value = i
でもいけますが、C1からを意識してRange("C1").Offsetにしています。