VBAで範囲を有するセルの記載位置を入れ替える

質問

お世話になります。
あるデータを扱うため、sheet_1に以下のような表を作成し管理を行っております。
sheetは複数存在するので、敢えてsheet_1とします。

（sheet_1）
　　　　　B列ーC列ーD列ーF列ーG列ーH列ーＩ列ーＪ列ーK列ーL列・・・
　３行　　Ａ　　　Ａ　　 Ａ　　 Ａ　　 Ｂ　　 Ｂ　 　Ｂ　　　Ｂ 　　Ｃ　　　Ｃ
　４行　　Ａ　　　Ａ　　 Ａ　　 Ａ　 　Ｂ　　　Ｂ　　 Ｂ　　　Ｂ 　　Ｃ　　　Ｃ
　５行　　Ａ　　　Ａ　　　Ａ　　　Ａ　 　Ｂ　　　Ｂ　　 Ｂ　　　Ｂ　 　Ｃ　　　Ｃ
　６行　　Ａ　　　Ａ　　　Ａ　　　Ａ　 　Ｂ　　　Ｂ　　 Ｂ　　　Ｂ　　 Ｃ　　　Ｃ

　７行　　Ｆ　　　Ｆ　　　Ｆ　　　Ｆ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｈ　　　Ｈ
　８行　　Ｆ　　　Ｆ　　　Ｆ　　　Ｆ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｈ　　　Ｈ
　９行　　Ｆ　　　Ｆ　　　Ｆ　　　Ｆ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｈ　　　Ｈ
１０行　　Ｆ　　　Ｆ　　　Ｆ　　　Ｆ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｈ　　　Ｈ

１１行　　Ｋ　　　Ｋ　　　Ｋ　　　Ｋ　 　Ｌ　　 　Ｌ　　 Ｌ　　　Ｌ 　　Ｍ　　 Ｍ
１２行　以下、上記のように続く

４列毎×４行毎の１６セル分の範囲を１情報として扱っているのですが、VBAを利用して記入された横方向の情報を下部行（例えば150行目）で縦に置き換える方法をご教授いただきたく投稿致しました。
変換元の対象範囲はＢ３：ＢＭ１２６です。

（sheet_1）
　　　　　 B列ーC列ーD列ーF列ーG列ーH列ーＩ列ーＪ列ーK列ーL列・・・
１５０行　　Ａ　　　Ａ　　 Ａ　　 Ａ　　　Ｆ　　　Ｆ　　 Ｆ　　　Ｆ　 　Ｋ　　　Ｋ
１５１行　　Ａ　　　Ａ　　 Ａ　　 Ａ　　　Ｆ　　　Ｆ　　 Ｆ　　　Ｆ　　 Ｋ　　　Ｋ
１５２行　　Ａ　　　Ａ　　　Ａ　　　Ａ　　　Ｆ　　　Ｆ　　 Ｆ　　　Ｆ　　 Ｋ　　　Ｋ
１５３行　　Ａ　　　Ａ　　　Ａ　　　Ａ　　　Ｆ　　　Ｆ　　 Ｆ　　　Ｆ　　 Ｋ　　　Ｋ

１５４行　　Ｂ　　　Ｂ　　　Ｂ　　　Ｂ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｌ　　　Ｌ
１５５行　　Ｂ　　　Ｂ　　　Ｂ　　　Ｂ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｌ　　　Ｌ
１５６行　　Ｂ　　　Ｂ　　　Ｂ　　　Ｂ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｌ　　　Ｌ
１５７行　　Ｂ　　　Ｂ　　　Ｂ　　　Ｂ　　　Ｇ　　　Ｇ　　 Ｇ　　　Ｇ　　 Ｌ　　　Ｌ

１５８行　　Ｃ　　　Ｃ　　　Ｃ　　　Ｃ　　　Ｈ　　　Ｈ　　 Ｈ　　　Ｈ　　 Ｍ　 　Ｍ
１５９行　以下、上記のように続く

同一sheet内ではなく、新たにsheetを作成して同じ結果を求める方法でも構いませんので、恐れ入りますがご教授宜しくお願い致します。

回答No.3

end-u · ベストアンサー

横から失礼。

>Private Sub CommandButton1_Click()
という記述から推測すると、シート上にCommandButtonを配してシートモジュールに書いたコードを実行していますね？
かつ、そのシートはSheet1ではないという事では。

シートモジュールでRangeの親を省略すると、そのモジュールが書かれているシートのRangeになります。
Sheet2のシートモジュールならSheet2.Range("B3:BM126")になります。
Sheet1.Select のあとに
Range("B3:BM126").Select としてしまうと、Sheet2がアクティブではないのでエラーになります。
仮に
Range("B3:BM126").Copy としても、Sheet2.Range("B3:BM126")が対象になるので、目的の範囲ではないかもしれません。

Rangeの親Objectからきちんと指定してあげましょう。
Private Sub CommandButton1_Click()
　　With Sheet1
　　　　.Range("B3:BM126").Copy
　　　　.Range("B150").PasteSpecial Paste:=xlPasteAll, _
　　　　　　　　　　　　　　　　　　Transpose:=True
　　　　'コピー後Sheet1を表示させたいなら
　　　　Application.Goto .Range("B150")
　　End With
　　Application.CutCopyMode = False
End Sub

複数のシートで処理したいなら標準モジュールにコードを置いて、
『Sheet1』ではなくActiveSheetに対して処理するように変更すれば良いでしょう。

お礼

end-u　様

ご回答いただきましたコードにて望んだ動作が得られました。
コードの意味をもっと勉強する必要があるものと痛感致しました。

ありがとうございました。

回答No.2

hige_082

これでうまく行かないでしょうか？

Private Sub CommandButton1_Click()
Sheet1.Select
Range("B3:BM126").Copy
ActiveWindow.SmallScroll Down:=120
Range("B150").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

回答No.1

nattocurry

範囲をコピーして、「形式を選択して貼り付け」で「行列を入れ替える」にすればよいです。

補足

nattocurry様

お世話になります。
早速試してみました。
動作は問題なく要望どおり行えました。
しかし、この動作をマクロの記録でコードを入手し、コマンドボタンを配して動作させると、デバッグになります。（矢印のコードが黄色くなります）

Private Sub CommandButton1_Click()

Sheet1.Select
Range("B3:BM126").Select　←　ココです。
Selection.Copy
ActiveWindow.SmallScroll Down:=120
Range("B150").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A1").Select

End Sub

どの様な修正でクリアできるかご教授願います。