エクセルでA行をコピーし、3列づつ貼り付ける方法

質問

エクセルでAの行（たとえばA1～A63まで）の文字列を全てコピーし、一括で3列21行の範囲内で張り付けることは可能でしょうか？

3列21行の範囲内で貼り付けるとは、たとえば下記の範囲内で、I2、J2、K2、I3、J3、K3の順番で張り付けることです。

I2、J2、K2
I3、J3、K3
I4、J4、K4
I5、J5、K5
・・・
・・・
I19、J20、K21

いろいろググってみたのですが、思うような答えが見つかりませんでした。

分かる方がおりましたら、何卒ご教示のほど、宜しくお願い致します。

回答No.3

eden3616 · ベストアンサー

VBAによる処理になります。

▼手順▼
(1)Alt+F11でVBEを開き、「挿入＞標準モジュール」よりモジュールを挿入
(2)最下のVBAコードを貼付
(3)右上の「×」でVBEを閉じる
(4)「元データの範囲」を選択後、Ctrlを押しながら「出力先の範囲」(先頭行のみ)を選択
　※添付画像を参考にしてください
　　・元データの範囲：黄色い背景色（A1：A63）
　　・出力先の範囲：緑色の背景色（I2：K2）
(5)Alt+F8でマクロウィンドウを表示し、「振り分け配置」を実行

出力先の範囲を先頭にし、下方向へ元データの範囲の値を順次コピーします。
書式含めたセルコピーを行う場合は、コード内の4行目「設定」で「cnf = 0」としてください。

■VBAコード
Sub 振り分け配置()
Dim cnf As Integer, i As Long, j As Long, AreaCount As Integer
Dim bs_Rng(1) As Range, bs_cnt(1) As Long, cnt As Long

cnf = 1 '設定(値のみの場合：1、セルのコピー：0)

AreaCount = Selection.Areas.Count
If AreaCount = 1 Then MsgBox "出力先の範囲が選択されていません": Exit Sub
For i = 1 To AreaCount
　　Set bs_Rng(i - 1) = Selection.Areas(i)
　　bs_cnt(i - 1) = Selection.Areas(i).Count
Next
If bs_Rng(0).Columns.Count <> 1 Then MsgBox "元データの選択列範囲が不正です": Exit Sub
If Not bs_cnt(0) Mod bs_cnt(1) = 0 Then
　　Set bs_Rng(0) = bs_Rng(0).Resize(bs_cnt(0) + bs_cnt(0) Mod bs_cnt(1), 1)
　　bs_cnt(0) = bs_Rng(0).Areas(1).Count
End If
For i = 0 To bs_cnt(0) / bs_cnt(1) - 1
　　For j = 0 To bs_Rng(1).Columns.Count - 1
　　　　cnt = cnt + 1
　　　　If cnf = 1 Then
　　　　　　bs_Rng(1).Cells(1, 1).Offset(i, j) = bs_Rng(0)(cnt).Value
　　　　Else
　　　　　　bs_Rng(0)(cnt).Copy bs_Rng(1).Cells(1, 1).Offset(i, j)
　　　　End If
　　Next j
Next i
End Sub

お礼

大変、貴重なご回答ありがとうございます。

回答No.4

msMike

I2: =OFFSET($A$1,(ROW(A1)-1)*3+COLUMN(A1)-1,)
で如何でしょうか？

お礼

ありがとうございます。

回答No.2

mshr1962

直接は不可能です。

VBAでショートカットキーで動作させるか

I2に数式を入力して、範囲全体にコピー後に、
もういちどコピーして値として貼り付けですね。

I2=INDIRECT("A"&(ROW()-2)*3+COLUMN()-8)
または
I2=OFFSET($A$1,(ROW()-2)*3+COLUMN()-9,0)
または
I2=INDEX($A$1:$A63,(ROW()-2)*3+COLUMN()-8)

お礼

ありがとうございます。

回答No.1

yumi0215

コピー元を選択し　Ctrl+C
コピー先を範囲選択し　Ctrl+V
これでは駄目でしょうか？

補足

そんなんじゃダメですよ・・・

一括貼り付けじゃないです。