横並びの一定の連続セルを立て並びに変えたい。

質問

横並びの一定の連続セルを立て並びに変えたい。
D2/E2/F2でひとつの項目があり、横並び同列にG2/H2/I2...と一定の連続セルが並んだデータがあります。これをD2/E2/F2の次の行に縦並びでD3/E3/F3として別のタブにコピーしたいのですが
どうすればいいですか。一項目ずつコピペでもいいのですが、元の横並びデータが膨大なので
一発でできる方法があるのなら教えていただきたいのでよろしくお願いします。

回答No.5

imogasi · ベストアンサー

質問内容をはっきり書くこと。
「元シートの３列づつ（DEF列、GHI列、JKL列・・）をそれぞれ別シートに分けたいということか。
そして別シートには列と行を入れ替える」ということか。
２行で表現できるじゃない。
関数では複雑に手作業的になるから、VBAしか手は無いでしょう。
ーー
マクロの記録の修正方法を良く知っておれば
６列（2回）で、私の５行のデータ例では、形式を選択して貼り付けー行と列を入れ替えるの操作をする。
Range("C1:E5").Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("Sheet3").Select
Range("F1:H5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet4").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
これに
（１）C1:E5　　などのC:Eを３列ごとに変化させる
（２）E5の５を最終行にあわせる
（３）右方向の３列ごとの繰り返しが、何処まで繰り返せば良いかを組み込む
で出来るだろう。
ーー
上記の点を修正して
Sub test01()
Dim sh1
Set sh1 = Worksheets("Sheet1")
s = 2
d = sh1.Range("D65536").End(xlUp).Row
MsgBox d
For j = 4 To 12 Step 3
'Range("C1:E5").Select
sh1.Select
sh1.Range(sh1.Cells(1, j), sh1.Cells(d, j + 2)).Select
Selection.Copy
Sheets(s).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
s = s + 1 '右のシートを指す
Next j
End Sub
For j = 4 To 12 Step 3　　の１２は自動化できるが手作業で行数を数えることにした。
最左にタブが在るシートが元データ。それからシートタブ位置的に順次のシートに書き出す例。

回答No.4

noname#159916

No.1 です。
なるほど、そういう意味でしたか。

ところで質問文＞縦並びでD3/E3/F3として別のタブにコピーしたいのですが
との事なので、別のSheetにコピーしたいって事ですか？＞質問者さん

私には Excelマクロの知識がないので内容も難易度も判断できないんですが
＞ではどうでしょうか。
と、（もしかしてマクロ使えないかも、な質問者さんに）逆質問されても
質問者さんは返答にすら困ってしまうかも知れません＞No.2,3さん

まぁ、基本的には大量だろうが手操作で行うのが解決法の１つです。
横方向のセル数は最大で256(A~IV)なので、手操作でこなせない数でもありません。
１単位３個なら256÷3=85...1 でしかありません。
最大数まで操作しなければいけないとしても、「85」は「膨大」と呼べる数ではありません。
No.2,3さんがマクロを示していただけましたけど、使うには敷居が高いと思われたなら
いちど手操作でやってみればいいと思います。
私も１度限りなら、と大量の処理を手操作でやった事はありますが、
意外にできるものですよ。

回答No.3

mar00

ANo.1さんへの補足を読ませてもらいました。
D2/E2/F2/G2/H2/I2/J2/K2/L2D2
D2/E2/F2
G2/H2/I2
J2/K2/L2
というふうにしたいという事でしょうか。
Sub Macro1()
COUNTER = 2
For i = 4 To Cells(2, Columns.Count).End(xlToLeft).Column Step 3
COUNTER = COUNTER + 1
Range(Cells(2, i), Cells(2, i + 2)).Copy
Cells(COUNTER, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Next i
End Sub
ではどうでしょうか。

回答No.2

mar00

D3/E3/F3というのは下の行にコピーしただけになりますが
D3/D4/D5の間違いでしょうか。
そうだとして
Sub Macro1()
For i = 4 To Cells(2, Columns.Count).End(xlToLeft).Column Step 3
Range(Cells(2, i), Cells(2, i + 2)).Copy
Cells(3, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Next i
End Sub
でどうでしょうか。

回答No.1

noname#159916

Excel ですね？

イマイチ状況を把握できてませんが、
単純に横並びの複数セルをコピーして
縦並びに変更して貼り付けたいなら

１行を選択→コピーし
縦並びにしたい先頭のセルで右クリック→
形式を選択して貼り付け(S)→
行列を入れ替える(E)にチェック入れて
ボタン[OK]するとできます。

補足

すべてのセルを横から縦に変えるのではなくD3/E3/F3はあくまで1セットとして横並び、同じセットの
G3/H3/I3をD4/E4/F4として持ってきたいのですが・・・・
例を言うと、商品/単価/個数という項目があってすべての商品が同列に長々と入力されているといった
感じです。説明不足ですみません。