エクセル マクロでセルを自動移動

質問

例1のようになっているエクセル表があります。
データは右方向、下方向へ増えます。
Cの列以降は4つ単位でしかデータは増えません。
それを例2の表のように列A,Bのデータはそのままに
Cの列以降の4つのセルを区切りに下の行に移動して、
空白の列まで言ったらA2の行以降を最後の行まで繰り返しするという
マクロを書くことは可能でしょうか。
出来ましたらそのマクロを教えてください。

例1
A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1
A2 B2 C2 D2 E2 F2 G2 H2 I2 J2
A3 B3 C3 D3 E3 F3 G3 H3 I3 J3 K3 L3 M3 N3

例2
A1 B1 C1 D1 E1 F1
A1 B1 G1 H1 I1 J1
A1 B1 K1 L1 M1 N1
A2 B2 C2 D2 E2 F2
A2 B2 G2 H2 I2 J2
A3 B3 C3 D3 E3 F3
A3 B3 G3 H3 I3 J3
A3 B3 K3 L3 M3 N3

回答No.2

_Kyle · ベストアンサー

なかなか回答がつかないようなので、とりあえず。

[移動]よりも[転記]の方が簡単ですし、高速です。

Sheet1のA1セル以下に元データがあり、
Sheet2のA1セル以下に転記する場合だとこんな感じかと。

'================↓　ココカラ　↓================
Sub Sample()
　Dim orSht As Worksheet
　Dim rtSht As Worksheet
　Dim i As Long '元範囲行カウンタ
　Dim j As Long '元範囲列カウンタ
　Dim k As Long '先範囲行カウンタ
　Set orSht = Worksheets("Sheet1")　'元シート
　Set rtSht = Worksheets("Sheet2")　'先シート
　i = 1 '元範囲先頭行
　k = 1 '先範囲先頭行
　Do Until orSht.Cells(i, 1) = ""
　　j = 3
　　Do Until orSht.Cells(i, j) = ""
　　　rtSht.Cells(k, 1).Resize(, 2).Value _
　　　　= orSht.Cells(i, 1).Resize(, 2).Value
　　　rtSht.Cells(k, 3).Resize(, 4).Value _
　　　　= orSht.Cells(i, j).Resize(, 4).Value
　　　j = j + 4
　　　k = k + 1
　　Loop
　　i = i + 1
　Loop
End Sub
'================↑　ココマデ　↑================

Excel2003で動作確認。以上ご参考まで。

お礼

Excel2002でしたが正常に動作しました。
大変助かりました。有り難うございます。

回答No.1

imogasi

コードを書いてくださいという質問（と言うより依頼）はこのコーナーの規約違反です。
こんな程度のことまで、丸投げするのは不勉強です。
ーー
ｄにデータ最終行を求める。
For i=1 to ｄ
ｒにi行の最右端列を求める
for j=3 r step 4
別にデータを持っていくシートの方の行カウンタをｋとする
A,B列をA,B列に。その後の４行をC-F列へ
K=K+1
jの繰り返し
iの繰り返し。
このロジックをまず抑えること。
＝＝
Sub test01()
Dim sh1, sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
d = sh1.Range("A65536").End(xlUp).Row
MsgBox d
k = 1
For i = 1 To d
r = sh1.Range("IV" & i).End(xlToLeft).Column
MsgBox r
For j = 3 To r Step 4
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
sh1.Activate
sh1.Range(Cells(i, j), Cells(i, j + 3)).Copy sh2.Cells(k, 3)
k = k + 1
Next j
Next i
End Sub
ーーー
全体的な構想を組み立てると言うことのほかに
この中で初心者に難しい点は
シートを２つ処理対象にする方法
最下行行番号を求める方法
最右列列番号を求める方法
コピー貼り付けを１行で済ます方法
データアウトプットのシートの記入位置を示す行ポインタのｋの使い方
などかな。これらを出来なければVBAで何も出来ない状態のはず。

お礼

規約違反とは知らず書き込んでしまい、すみませんでした。
そんな私にご丁寧に回答頂き有り難うございます。