Excel2007 他ブックに対してマクロを実行

質問

Excel2007を使用しています。

あるシートに対して並び替えを行うマクロを作り、ちゃんと動作している事を確認しました。
ちなみに、以下のようなマクロです。

---------------------------------------------------------------------------------

Sub Macro2()
Dim a As Range

'(1)部のユーザー設定リスト追加
Application.AddCustomList ListArray:=Array("Ａ部", "Ｂ部", "Ｃ部", "Ｄ部")

'(2)部はどこ列か
Set a = Range("1:1").Find(what:="部", LookIn:=xlValues, lookat:=xlPart)
If a Is Nothing Then
MsgBox "部が見つかりません"
Exit Sub
Else
MsgBox a.Column & "列に部を発見しました"
End If

'(3)取得した部列基準で全体の並べ替えを行う
a.CurrentRegion.Sort key1:=a, order1:=xlAscending, Header:=xlYes, ordercustom:=(Application.CustomListCount + 1)

Application.DeleteCustomList (Application.CustomListCount)

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

動作↓
(1)ユーザーリストの設定
(2)シートの見出し行で、「部」を含むセルを検索
(3)そのセルを含む列を基準に、(1)で設定した順にソート

このマクロを使用して、

(1)並び替えを行いたいエクセルデータ(A)を用意
(2)新しく作成したブック(B)にファイルを参照するマクロ（ファイルを自分で選ぶようにダイアログを表示させたい）と、そのファイルに対して
並び替えを行うマクロ（既に作成済み）を作成
(3)ブック(B)からデータ(A)を参照
(4)並び替えを行うマクロを実行させ、その結果を別ファイルで保存

という事をさせたいのですが、どのようなマクロを作成すればよいか検討が付きません。
分りにくい説明で申し訳ございませんが、どなたかヒントをいただけたらと思います。
宜しくお願いしますm(_ _)m

回答No.1

keithin · ベストアンサー

あれ，いつの間にか解決したんですか。
結局ユーザー設定リストの番号を事前に調査しておくのはヤメにしたワケですね。

今回のご質問。
＞（１）
これはマクロと関係なく，事前の準備としてあなたが用意することです。

＞（２）
ブックを参照して開く
sub macro3()
　dim myFile as variant
　dim w as workbook
　dim a as range
　Application.AddCustomList ListArray:=Array("Ａ部", "Ｂ部", "Ｃ部", "Ｄ部")

　myfile = application.getopenfilename()
　if f = false then exit sub
　set w = workbooks.open(filename:=myfile)

＞(3)ブック(B)からデータ(A)を参照

何をしたいのかも，今回ご質問の一連のマクロとどんな関連があるのかも，全くイミフメイです
多分，何かデータを参照する数式をブックＢに用意しておくのが良いと思われます。
必要に応じてこの部分は具体的な事例を挙げて，また別途ご相談を投稿してみてください。

＞（４）
前回完成したマクロをそのまま上述Macro3に続けます
なお，開いたファイルの「どのシート」が操作対象のシートなのか，説明されていません。ご自分で適切にマクロを手直しして実行してください。

　Set a = w.worksheets(1).Range("1:1").Find(what:="部", LookIn:=xlValues, lookat:=xlPart)
　If a Is Nothing Then
　　MsgBox "部が見つかりません"
　　Exit Sub
　Else
　　MsgBox a.Column & "列に部を発見しました"
　End If

'(3)取得した部列基準で全体の並べ替えを行う
　a.CurrentRegion.Sort key1:=a, order1:=xlAscending, Header:=xlYes, ordercustom:=　(Application.CustomListCount + 1)

　myFile = application.getsaveasfilename()
　if myfile = false then exit sub
　w.saveas filename:=myfile
　w.close savechanges:=false

　Application.DeleteCustomList (Application.CustomListCount)

End Sub