エクセル2003にて列を別シートを追加し、コピーするには？

質問

エクセル2003にて列を別シートを追加し、コピーするには？

お世話になります。

以下のような処理をしようとした場合、どのようなマクロを
組むことで可能になるのでしょうか？
お忙しい中、恐縮ですが、アドバイスをお願いします。

　　A　　　　B　　　　C　　　D
１りんご　500円　青森産　○×農園
２みかん　200円　愛媛産　○△農園
３すいか　150円　山梨産　△×農産

という、エクセルデータがあったと仮定して、、、

自動的にシートを追加し、1枚のシートには

　　A　　　　B　　　　　　　
１りんご　○×農園
２みかん　○△農園
３すいか　△×農産

これも自動的に一枚のシートを追加して、、、

　　A　　　　B　　
１500円　○×農園
２200円　○△農園
３150円　△×農産

といった２シートに分けるようにしたいと思ってます。
（※シート名は、入力できてもできなくてもOKです。）

上述くらい簡単なら、手作業でも実施しますが、
列がFF近くまであり、行も5000行近くありますので、
出来る限り自動化したいところです、、、

是非、アドバイスをご享受頂けたら幸いです。

回答No.2

qyukip · ベストアンサー

やりたいことができているかはわかりませんが、列ごとにシートを分けるマクロを作ってみました。
これはタイトル行があると仮定してシート名にタイトルを使用しています。

Const TITL_ROW As Integer = 1 'タイトル行

Private Sub CommandButton1_Click()
Dim WSName As String '追加するワークシート名
Dim NOWSHeet As String '現在のシート名
Dim i As Integer
NOWSHeet = ActiveSheet.Name '現在のシート名取得
WSName = "シート名"
For i = 1 To Worksheets(NOWSHeet).Cells().SpecialCells(xlCellTypeLastCell).Column
Worksheets.Add Before:=Worksheets(NOWSHeet) '新規シートの追加
WSName = Cells(TITL_ROW, i).Value 'タイトルをシート名にする
ActiveSheet.Name = WSName 'シート名変更
Worksheets(NOWSHeet).Range(Cells(1, i), Cells(1, i)).EntireColumn.Copy '列をコピー
Worksheets(WSName).PasteSpecial '貼り付け
Next
End Sub

お礼

ありがとうございます。
勉強になります。

お忙しい中、ありがとうございます。

回答No.1

sumer45

言ってる事がイマイチよくわかりません

VBAで対応する場合　規則性を探します

シートすべてをコピーして
そこから不要なColumn番号を指定して削除するという方法もあります
その場合　削除するColumn番号にどのような規則があるか　という事になります
シートは左から数えて1,2,3ですから　これに関連性を持たせることができるなら
For　Each～　でループ処理をすればいいのです

お礼

アドバイスありがとうございます。

列をコピーして、、、と考えていましたが、
おっしゃるとおり、シートごとコピーして
不要な分を削除すればいいですね！

検証してみたいと思います。
ありがとうございます。