列を変更して転記したいのですが。

質問

すみません、誰か教えていただけませんか。
A列に値が入力がされていて、その値をF列に転記していき
15行までいけば２列横にズレて転記していき更に、15行で
2列横と続けたいのですがうまく出来ません。
下記のように記述してみたのですが、値が置き換わるだけで
転記出来ません。
誰か教えて頂けませんでしょうか。

Sub TEST()
Dim i As Long, ii As Long
Dim myR As Long

myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
ii = 5
For i = 1 To myR

Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value
If Cells(1, ii).End(xlUp).Row = 15 Then
ii = ii + 2
End If
Next i

End Sub

宜しくお願いします。

回答No.2

kmetu · ベストアンサー

Cells(1, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value

Cells(1, ii)で1行目を指定して最終行を求めていますので全てE列(ii=5なので)の1行の右横(F1）に転記する記述となっています。

Cells(Rows.Count, ii).End(xlUp).Offset(0, 1).Value = Cells(i, 1).Value

このように変更したとしてもE列には何も値がありませんから全てF1にデータが入ることになります。
ii = 6にして
Cells(Rows.Count, ii).End(xlUp).Offset(1, 0).Value = Cells(i, 1).Value

としたらいけそうに感じますが、列に何もデータが無い場合End(xlUp)でいちばん最初に返る値が0ではなく1なので、2行目からデータが転記されていきます。1行めに項目行があればfor i=2 にして Ifの=15を=16にしておけばこれでもいけるでしょう。ただし、If Cells(Rows.Count, ii).End(xlUp).Row = 16 Then　にしてください。

1行めからデータを転記したい場合には上記の理由でOffsetが使えませんから質問者さんのコードをなるべく変更しないように考えた場合、単純に変数を1個追加して以下のようにしてもいいと思われます。

Sub TEST2()
Dim i As Long, ii As Long, j As Long
Dim myR As Long

myR = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
ii = 6
j = 1
For i = 1 To myR
Cells(j, ii).Value = Cells(i, 1).Value
If j = 15 Then
ii = ii + 2
j = 1
Else
j = j + 1
End If
Next i

End Sub

何か変だなと思ったら、変数を使って指定してる箇所の値をDebug.Printで確認することができます。
今回の場合だと、たとえば
Debug.Print Cells(1, ii).End(xlUp).Offset(0, 1).Address
とするとイミディエイトウィンドウに書き込もうとしているセルのアドレスが表示されます。

お礼

kmetu様

ありがとうございます。
詳しく解説して頂き、とても勉強になりました。
ありがとうございます。

回答No.1

keithin

＞15行までいけば２列横にズレて

２列動かした「どこの行に」転記したいのですか。

ふつーに？考えると：
sub macro1()
　dim r as long, c as long
　c = 6

　for r = 1 to range("A65536").end(xlup).row step 15
　　cells(1, c).resize(15,1).value = cells(r, 1).resize(15,1).value
　　c = c + 2
　next r
end sub

ご相談を文字通り読み取ると：
sub macro2()
　dim r1 as long, r2 as long, c as long
　c = 6

　for r1 = 1 to range("A65536").end(xlup).row step 15
　　for r2 = r1 to r1 + 14
　　　cells(r2, c).value = cells(r2, "A").value
　　next r2
　　c = c + 2
　next r1
end sub

お礼

keithin様

ありがとうございます。
質問内容があいまいで申し訳ございません。
ふつーに考える方が、私が求めてものです。
ありがとうございます。