3つのブックで指定した列（3箇所）のみを別ブックへ書き込むには？

質問

何卒、ご教示願います。
初心者です。WinXP、Excel 2002を使用。

同じxlsウインドウ内に3つのブックがあります。
松20060730.xls　　竹20060730.xls　　梅20060730.xls　　…3つは同型内容のデータ
それぞれ12シート（1S～12S）ある数字のデータ（最高行170行以下で変動します）　の
→3つの指定した列のみを→　同じxlsウインドウ内の別ブック「集計1」（A列と1行が項目名）に書き込む。
1回のマクロ実行で可能なのでしょうか？

---------------------------------------
Sub 3つのブックを1つのブックへ()
　　Call Test1
　　Call Test2
　　Call Test3
　ブック「集計1」を「昇順に並び替える」
　「行列を入れ替える」　　
End Sub
---------------------------------------
A　 B 　C 　D 　E 　F 　G 　H 　I 　　・・・・・・　　　N・・・
01　松　　2006年07月30日
9:00
あ　い　赤　う　ま　さ　こ　き　青　ち　く　と　ね　黄
　　　　32.3　　　　　　　　　　　　9.9　　　　　　　6.3　　　　　
　　　 136.3　　　　　　　　　　　 31.8　　　 　　1369.3　
　　　　74.3　　　　　　　　　　　424.8　　　　　　681
赤（C3…全シート同じ）
青（I3 …全シート同じ）
黄（N3…全シート同じ）

Sub Test1()
「赤」列の36データ（項目名：赤も含む）　を　別ブック「集計1」のB2～B37に　松竹梅の順で　横へ順次書き込む

Sub Test2()
「青」列の36データ（項目名：青も含む）　を　別ブック「集計1」のB38～B73に　松竹梅の順で　横へ順次書き込む

Sub Test2()
「黄」列の36データ（項目名：黄も含む）　を　別ブック「集計1」のB74～B109に　松竹梅の順で　横へ順次書き込む

以上のような内容でございますが、何卒よろしくお願い致します。

回答No.5

papayuka · ベストアンサー

#2です。

> 最後の下記部分だけなんですが、実行されない
> ここがポイントだと思い、考えたのですが…

#2の補足で Macro2 は動作済みだった筈ですが、そうでは無いのでしょうか？
エラーが出ないなら、最終シートには少なくとも１列は転記されていると思いますが、、

36枚のデータ用シートのセル J1 が空なのではありませんか？

Range("IV1").End(xlToLeft).Offset(0, 1)
は セル IV1 から Ctrl + ← キーを押して移動したセルの１つ右のセルを意味します。

各データ用シートの J1 が空の場合、この動作は何度繰り返しても同じセルを選びます。
そのため、データの先頭が J4 ならば、最終列判定は IV4 でないといけません。
但し 4行目と言う半端なセルへ「列」を貼り付ける事は出来ないので EntireColumn で列全体の指定に直してやります。

　Worksheets(i).Range("J:J").Copy _
　　Destination:=Worksheets(Worksheets.Count).Range("IV4").End(xlToLeft).Offset(0, 1).EntireColumn

'-----------------

以上は単なる推測です。
文章だけのやり取りでは、提示されたコードを適宜 自分の環境に置き換える程度のスキルは最低限必要ですよ。
初心者は免罪符ではありませんし、求めているものは初心者が望む以上の物だと感じます。

お礼

申し訳ございませんでした。
推測された通りでございます。実行されました。
私の質問欄記載の表の通り、J1は空であり、動作確認済はC列「赤」の列（C1は文字があり）で実行したので表示されました。
十分承知してはいるのですが、自身が遂行しなけらばならない、いち作業があるので、順不同で飛び越えて行っている次第でございます。
ほんとに、有難うございました。

補足

誠に、申し訳ございません。
以前のコード（複数の行を列方向へ昇順に並び替える）を
　　↓
「複数の列を行方向へ昇順に並び替える」に
編集（下記）しようとしてるんですが、どうしてもうまく行きません。
ご教示くださいませ。
下記例は、3行目が項目（B3以降）、最後行が320行以下（変動あり、空白あり）でございます。
-----------------
Sub 複数の列を行方向へ昇順に並び替える()
Dim r As Range
With Worksheets(Worksheets.Count)
For Each r In .Range("B3", .Range("IV3").End(xlLeft))
r.Offset(1, 0).Resize(320,).Sort key1:=r.Offset(1, 0), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
Orientation:=xlTopToBottom
Next r
End With
End Sub
-----------------

回答No.6

papayuka

#2です。

ヘルプを活用しましょう。
End であれば、En|d のように単語内にカーソルを入れてF1キーでヘルプが出ます。
見れない場合はVBAのヘルプをOfficeのCDから追加インストールして下さい。

End(xlLeft) 　→　End(xlToLeft)
Resize(320,)　→　Resize(320,1)

補足の域を超える（と言うか元の質問と繋がってない）質問がこれで２回目です。
私は専属の指導員ではありませんので、この回答を最後にします。

お礼

度々、誠に、有難うございました。
解らない事は、別ページにて、質問したいと思います。

回答No.4

papayuka

#2です。
ループをマスターしましょう。ループの構文は数パターンで後は応用です。
For i = 1 to x ～ Next、For Each x in xs ～ Next、Do ～ Loop

Sub SheetLoop1()
　For i = 1 To Worksheets.Count
　　　MsgBox Worksheets(i).Name
　Next i
End Sub

Sub SheetLoop2()
　For Each w In Worksheets
　　　MsgBox w.Name
　Next w
End Sub

Sub BookLoop1()
　For i = 1 To Workbooks.Count
　　　MsgBox Workbooks(i).Name
　Next i
End Sub

Sub BookLoop2()
　For Each w In Workbooks
　　　MsgBox w.Name
　Next w
End Sub

「Macro1」と「Macro2」と「複数の列を1つの列にする」は１つのループに収まるものではないですか？
iだけ変数がダブっているのでmyColにしましたが、、

Sub hogehoge()
'目的セルを～ より転記
Dim r As Range, base As Range
Dim x, y
Dim i, myCol

'Macro2より
For i = 1 To Worksheets.Count - 1

　'目的セルを～とMacro2でSelectを使用しているため追加
　Worksheets(i).Select

　'Macro1よりより転記
　Range("J4:K158").Select

　'目的セルを～ より転記
　Set r = Selection
　Set base = Selection.Cells(1, 1)
　x = r.Columns.Count
　y = r.Rows.Count

　For myCol = 1 To x - 1
　　 base.Offset(0, myCol).Resize(y).Copy base.Offset(y * myCol)
　Next
　base.Offset(0, 1).Resize(y, x - 1).Clear
　base.Select

　'Macro2より転記
　Worksheets(i).Range("J:J").Copy _
　　Destination:=Worksheets(Worksheets.Count).Range("IV1").End(xlToLeft).Offset(0, 1)

Next i

End Sub

補足

どうも、誠に有難うございます。
度々、すみいません。
最後の下記部分だけなんですが、実行されない（エラーではなく、表示されない）ので、自身で思考錯誤してみたのですがうまくできません、
＞iだけ変数がダブっているのでmyColにしましたが、
ここがポイントだと思い、考えたのですが…
よろしくお願い致します。
--------------------------
'Macro2より転記
　Worksheets(i).Range("J:J").Copy _
　　Destination:=Worksheets(Worksheets.Count).Range("IV1").End(xlToLeft).Offset(0, 1)

Next i

End Sub
--------------------------

回答No.3

papayuka

#2です。

> 下記　Macro1の手動をせずに「Macro2」とのよい繋ぎ方が自身ではうまく出来ません。
> Range"J4:K158"　は　36（変動あり）シート全部同じです。
> もしよろしかったら、是非ご教示下さいませ（私の編集部分も併せて）。

ご質問の意味も何が質問なのかも解りませんでした。
分散したマクロは順番に Call する Sub を作るか、同じ Sub～End Sub内に記述してやれば良いだけです。

Macro1 で「複数の列を1つの列にする」マクロが記述されておらず、何をしているのかも解りませんし、、、

補足

説明・解釈不足で大変すみません。
Macro1とMacro2を、繋げる必要はなかったわけでしたね。
Macro1　のまとめ方がうまくできないということでした。
よろしくお願い致します。
＞Application.Run "複数の列を1つの列にする"　は下記に記載します。

現状ですと、Macro1を36回（変動あり）実行することになります。
つまり、36（変動あり）シートなので、手動にて、"J4:K158"を36回範囲選択し、
手動にて"複数の列を1つの列にする"を36回実行することになります。
が、
『36シート分全部を1度に"J4:K158"を選択し、"複数の列を1つの列にする"を実行』　のマクロを作成すればよいわけですか？　
そして、Call Macro2　すればよいわけでしょうか？
----------
Public Sub 目的セルを手動選択後に複数の列を1つの列にする()
Dim r As Range, base As Range
Dim x, y
Dim i
Set r = Selection
Set base = Selection.Cells(1, 1)
x = r.Columns.Count
y = r.Rows.Count

For i = 1 To x - 1
base.Offset(0, i).Resize(y).Copy base.Offset(y * i)
Next
base.Offset(0, 1).Resize(y, x - 1).Clear
base.Select
End Sub
------------

回答No.2

papayuka

可能かと言う質問に対しての回答は「可能です」になります。
セル範囲、シート名、ブック名などがいつも固定ならば、それぞれマクロ記録を取って順番にCallすれば良いだけですが、行などが可変となると書換えが必要です。

可変行とシートループ処理は前々回の質問時にサンプルを書きました。
それらを検証してご自分の物にしないといつまでも上達しません。

ご質問には何度か回答していますが、だんだん丸投げになって来ているような印象を受けました。

補足

大変申し訳ございませんでした。今の私の能力・時間等では、仕方が…。
おかげさまで、非常にガサツですが、なんとか(3つのブックを1つにすることにより)、本質問は、自身にて解決できたと思います。
が、
＃1様の以前の下記「Macro2」を　列を貼り付けるように編集させて頂きましたが（動作済）、
下記　Macro1の手動をせずに「Macro2」とのよい繋ぎ方が自身ではうまく出来ません。
Range"J4:K158"　は　36（変動あり）シート全部同じです。
もしよろしかったら、是非ご教示下さいませ（私の編集部分も併せて）。
-------
Sub 下記Macro1とMacro2()
　ブック1の36（変動あり）シート全部に手動作業後、Macro1を完了し、
　Call Macro2
End Sub
-------
と、行っても可能だと思うんですが、
もっとシンプル（1回の実行）に出来るのでしたら、是非ご教示下さいませ。
------------------------------
目的セルを手動選択後に複数の列を1つの列にする
Sub Macro1()
'
' Macro1 Macro
' 目的セルを手動選択後に複数の列を1つの列にする
'
Range("J4:K158").Select
Application.Run "複数の列を1つの列にする"
End Sub
------------------------------
複数シートのある列を→最後のシートの列へ順次貼り付ける
Sub Macro2()　　　
Dim i As Integer
On Error Resume Next
For i = 1 To Worksheets.Count - 1
　　Worksheets(i).Range("J:J").Copy _
　　Destination:=Worksheets(Worksheets.Count).Range("IV1").End(xlToLeft).Offset(0, 1)
Next i
End Sub
------------------------------

回答No.1

NCU

そのまま記述されればよろしいのでは？
どこかわからない点でもあるのでしょうか？
うまくいかない点を、コード、エラーメッセージと共に質問して下さい。