エクセルVBA 偶数のセルを奇数のセルに移動させたい！

偶数のセルを奇数のセルに移動させて空白行を削除するVBAを教えてください。

Ａ列に

A1[大根]
A2[100円]
A3[人参]
A4[150円]
A5[茄子]
A6[180円]

こんなデータがあるとして、

VBAを使って

A1[大根] B1[100円]
A2[人参] B2[150円]
A3[茄子] B3[180円]

このように表示させたいです。

No.3 ベストアンサー 回答者： kamejiro 回答日時： 2022/03/03 20:34

試してみました。

’偶数のセルを奇数のセルに移動（空白になるまで）
i = 1
Do Until Cells(i, 1) = ""
Cells(i, 2) = Cells(i + 1, 1)
Cells(i + 1, 1) = ""
i = i + 2
Loop

’続けて（空白になった行を消す）
For j = 3 To i - 2 Step 2
Cells((j - 1) / 2 + 1, 1) = Cells(j, 1)
Cells(j, 1) = ""
Cells((j - 1) / 2 + 1, 2) = Cells(j, 2)
Cells(j, 2) = ""
Next j

この回答へのお礼

回答ありがとうございます。

上手くできました。

お礼日時：2022/03/03 22:26

No.2 回答者： satoumasaru 回答日時： 2022/03/03 17:54

「マクロの記録」でつくられたらいかがでしょう？

その方が簡単にできますよ。

Excel 2010でマクロ機能を使用して操作を記録する方法
https://faq.nec-lavie.jp/qasearch/1007/app/servl …

No.1 回答者： LHS07 回答日時： 2022/03/03 17:50

'

' Macro1 Macro
'

'

Rem 移動
Rem A2 -> B1
Range("A2").Select
Selection.Cut
Range("B1").Select
ActiveSheet.Paste

Rem A4 -> B3
Range("A4").Select
Selection.Cut
Range("B3").Select
ActiveSheet.Paste

Rem A6 -> B3
Range("A6").Select
Selection.Cut
Range("B5").Select
ActiveSheet.Paste


Rem 行削除
Rem 2行目
Rows("2:2").Select
Selection.Delete Shift:=xlUp

Rem　3行目削除
Rows("3:3").Select
Selection.Delete Shift:=xlUp


End Sub

以上です。