「 複数ワークシートごと 」 を、希望順に 「 別ブック 」 へ貼り付けるマクロは ？

エクセル　２００２　です。
シートの数は、必ず　３６　以下です。

下記例は、
１、「 頭の　AK 」　は　必ず、　全部同じです。
２、「 数字部分の２桁 」　は、　必ず、　　01 ～ 10　です。
３、「 * 」　は、　必ず、　6 桁　です。
４、たとえば下記例の　「 AK01****** 」　は、
　　「 AK01****** 　だけの見出し全部 （ AK01　だけが全く同じのデータが必ず続いてます） 」　
　　　を　
　　「　01　の　エリア 　」　と　表現させて頂ます。　　　
５、この　エリア　は　必ず、２つ　か　３つ　です。（ 下記例では、エリア　は　３つ　です）

この　エリア順　を　希望順に、　「 別ブック2 」　へ貼り付けたいのです。
何卒、ご教授くださいませ。
---例----------------------------------------------
ブック1　（ エリア順が　01、04、10　です ）
シート見出し
AK01******　・・　AK01******　AK04******　・・　AK04******　AK10******　・・　AK10******

別ブック2　（ エリア順を　10、04、01　にしたいです ）
シート見出し
AK10******　・・　AK10******　AK04******　・・　AK04******　AK01******　・・　AK01******

No.1 ベストアンサー 回答者： ja7awu 回答日時： 2007/01/12 09:47

> 希望順に、　「 別ブック2 」　へ貼り付けたいのです。

「希望順」とは、シート名の昇順　で並べ替えることのように解釈するのですが、
もし、それで宜しければ、こんな感じで如何でしょうか。


Sub ShCopySort()
'全シートを新ブックへコピーし、シート名で並べ替え
Dim N As Integer
Dim M As Integer
Worksheets.Copy
For N = 2 To Worksheets.Count
　　For M = 1 To N - 1
　　　　If Worksheets(M).Name > Worksheets(N).Name Then
　　　　　　Worksheets(N).Move before:=Worksheets(M)
　　　　　　Exit For
　　　　End If
　　Next M
Next N
End Sub
　

この回答への補足

ご回答、誠に有難うございます。
＞「希望順」とは、シート名の昇順　で並べ替えることのように解釈するのですが、

昇順だけとは、限りません。
質問内容不足で、すみません。
---他の例----------------------------------------------
ブック1（ エリア順が　02、05、10　です ）
シート見出し
AK02******　・・　AK02******　AK05******　・・　AK05******　AK10******　・・　AK10******

ブック2（ エリア順を　10、02、05　にしたいです ）
シート見出し
AK10******　・・　AK10******　AK02******　・・　AK02******　AK05******　・・　AK05******
------------------------------------------------
補足
１、　全部で、何通りの組合せが存在するか　？

例えば、
今回の質問の「 １通り 」　は、エリア順　「 １・２・３ 」　を　→　「 ３・２・１ 」にしました。

今回の例を、１通り　の希望順　と　しますと、
１、　例えば、「エリア　が　３つ　の場合 」の、希望順は、全部で　「 ５通り 」　となります。
エリア順　「 １・２・３ 」　→　「 ３・２・１ 」にします。
エリア順　「 １・２・３ 」　→　「 ３・１・２ 」にします。
エリア順　「 １・２・３ 」　→　「 ２・３・１ 」にします。　
エリア順　「 １・２・３ 」　→　「 ２・１・３ 」にします。
エリア順　「 １・２・３ 」　→　「 １・３・２ 」にします。
エリア順　「 １・２・３ 」　→　「 １・２・３ 」にします。×　同じなので不必要。

２、　例えば、「エリア　が　２つ　の場合 」の、希望順は、全部で　「 １通り 」　となります。
エリア順　「 １・２ 」　→　「 ２・１ 」にします。
エリア順　「 １・２ 」　→　「 １・２ 」にします。×　同じなので不必要。

--最終的には下記へつなげたいと考えております---------------
Sub 見出し並び替え()

Dim sort_key As String
Dim sDataArray As Variant

Dim i As Long
Dim j As Long

sort_key = InputBox("ソートキーを入力してください" & vbCrLf & "10,04,01　のような感じで入力してください")
・
・
End Sub

補足日時：2007/01/12 18:40

この回答へのお礼

お礼が、遅くなって誠に申し訳ありませんでした。
未熟なりに、ご回答コードを試行錯誤してました。
まだ完全では、ありませんが、複数通りコードで可能じゃないかと思います。
どうも有難うございました。

お礼日時：2007/01/17 00:40

No.2 回答者： Wendy02 回答日時： 2007/01/16 16:42

こんにちは。

どうやら回答がつかないようですね。

oshietecho-dai　さんのご質問は、ここ最近のものはすべてみていますが、なかなか、回答がつけにくい気がしました。今回（前回）のご質問は、あるレベル以上の人からすれば、それほど難しいものではありません。

同じような質問を繰り返すと、いままでの常連さんは回答をつけなくなってしまいます。なるべく、同系の質問は一度キリにしてしてください。それと、「Sub 見出し並び替え()
」は、ご自身のものですか？もし、そうでしたら、前回の方の説明をもう少し詳しくさせていただきます。

配列用の変数を、ファイル名を配列に入れます。

それを、私ならは、バブル・ソートアルゴリズムを使います。そして、該当しないシートの存在を考慮して、シートの　Index 1 のところで、配列変数の添え字の上(Ubound)から、順に下位に入れていきます。

次に、その配列変数を、Filter 関数を使って、抜き出して、それを再び、同じようにシートの並べ替えをしていけば出来上がります。

つまり、シートの並べ替えと、ユーザーオプションの並べ替えは、同じ流れの中で行います。

この回答へのお礼

こんばんわ、
ご回答、誠に有難うございます。
度々と申し訳ありませんでした。
時間はかかりますが、試行錯誤していきます。

お礼日時：2007/01/17 00:53