VBAでおしえてください

質問

またまたお世話になります。今５個のエクセルファイルがあります。
B1 C1 D1 ・・・・
5 4 0
4 2 2
2 1 3
というふうに、１枚のSHHETに数字が並んでおり、B1,C1,D1をラベルとしています。 これをラベルごとにSHEETを分けて貼り付けたいです。
B1sheetのB2セルに5,B3セルに4,B4セルに2という具合です
C1sheetも同様です。
よろしくおねがいします

回答No.2

papayuka · ベストアンサー

#1です。

先の例はアクティブなブックに対して実行されますので、マクロ含むブックか否かは関係ありません。

ある程度はご自身で書き換え出来る知識が無いと業務での運用はキツイですよ。
ループなどは殆ど決まった構文に当てはめるだけで、少しの手直しで応用出来ます。
前回サンプルの For Each ～ Next 文を使って、下記のようにすると一緒に開いていて、非表示になっていない全てのブックに処理をする事になります。

Sub Test1()
Dim ws As Worksheet, wb As Workbook, i as Integer
On Error Resume Next
For Each wb In Workbooks
　If Not wb Is ThisWorkbook And Windows(wb.Name).Visible Then
　　For i = 2 To 4
　　　wb.Worksheets(1).Columns(i).Copy
　　　Set ws = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
　　　ws.Name = wb.Worksheets(1).Cells(1, i).Value
　　　wb.Worksheets(1).Columns(i).Copy ws.Columns(2)
　　Next i
　End If
Next wb
End Sub

お礼

ありがとございます＾＾ できました。そうなんです、自分でできないと業務で作成するときにつらいんです。今がそうなんですが。。
VBAは業務でたまに必要になるのですが、たまになので、時間があくと忘れちゃいます。 常々、勉強しないとダメですね。。で。。もう少しだけお付き合いお願いします、また新規に質問させていただきますのでよろしかったら、ご回答お願いします。土日につくらなかればいけず、自力では今から勉強してもつらいです・・
よろしくお願いします

回答No.1

papayuka

条件が不明瞭な部分もあるので参考程度にしてください。

下記は一番左のシートのB～D列に対し、シートを追加してB列に貼り付けます。

Sub Test1()
Dim ws As Worksheet
　On Error Resume Next
　For i = 2 To 4
　　　Worksheets(1).Columns(i).Copy
　　　Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　ws.Name = Worksheets(1).Cells(1, i).Value
　　　Worksheets(1).Columns(i).Copy ws.Columns(2)
　Next i
End Sub

お礼

papayukaさん、またまたありがとうございます。
先の質問で教えていただいたように、５個とは別のエクセルファイルに
プログラムを書いておいて、実行したいのですが可能でしょうか。
でないと、５個のＤＡＴＡファイルをＶＢＡのファイルにコピーしてから実行になりますよね。。。 どうぞよろしくお願いします