Excelシートの移動について

質問

いつもお世話になります。Excel2000を勉強中の初心者です。

ひとつのブックにワークシートが100枚くらいあります。
各シートに担当者の名前をつけています(例、山田、鈴木、田中、佐藤、安部．．．)。しかし、sheet1から新規シートを作成するたびに、担当者の名前をランダムにシート名としてつけていたため、ブック内のシートの順番がバラバラの状態です。これらのシートをあいうえお順になるようにブック内でシートの移動をしたいのですが、シート枚数が多いので、一つずつ移動していくのは大変な作業になりそうです。

なにか、一発であいうえお順にシートを移動することができる方法はないでしょうか?

よろしくお願いします。

回答No.4

ja7awu · ベストアンサー

> エラーの原因について教えていただけませんでしょうか?

数字だけを使ったシート名がありませんでしょうか。
急ぎましたので、その他にも検証が、足りなかったようです。

今度のは、「数字だけの名前」と「非表示シート」にも対応しましたので、
大丈夫だと思います。
（ No.3 は、無視してください。）

Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Application.ScreenUpdating = False
Sheets.Add Before:=Worksheets(1)
Set Wwh = ActiveSheet
For N = 2 To Worksheets.Count
　　Cells(N - 1, 1).Value = Worksheets(N).Name
　　Cells(N - 1, 2).Value = _
　　Application.GetPhonetic(Worksheets(N).Name)
Next N
Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
　　Order1:=xlAscending, Header:=xlNo, OrderCustom:=1 '昇順
'Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
　　Order1:=xlDescending, Header:=xlNo, OrderCustom:=1 '降順
For N = 1 To Range("A1").End(xlDown).Row
　　Worksheets(CStr(Wwh.Cells(N, 1).Value)).Move After:=Sheets(N)
Next N
For N = 2 To Worksheets.Count
　　If Worksheets(N).Visible = xlSheetVisible Then
　　　　Worksheets(N).Activate
　　　　Exit For
　　End If
Next N
Application.DisplayAlerts = False
Wwh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub

回答No.6

noname#64217

NO1のosuosuです。
横から失礼します。

haasan99さんの目的は「あいうえお順」ですよね。
掲載されているVBAコードは「漢字コード順」になっています。
つまり、漢字の音読みによって並べ替わるものです。
正確なあいうえお順にはなりません。
質問の趣旨と異なるもので、いくらエラーをなおしても、お望みの並べ替えはできません。

初心者ということですので、お気づきになっていなかったら時間の無駄になってしまい、かわいそう・・・と思い意見させていただきます。
余計なお世話だったらごめんなさい。

お礼

アドバイスありがとうございました。
シートの名前を若干手直しして対応いたしました。
ご親切にありがとうございました。_(._.)_

回答No.5

ja7awu

ちょっとコードを整理しました。
こちらでテストしてみてください。

Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Const UpDown = 1 ' <------ １=昇順　/　２=降順 を指定
Application.ScreenUpdating = False
Sheets.Add Before:=Worksheets(1)
Set Wwh = ActiveSheet
With Wwh
　　.Visible = False
　　For N = 2 To Worksheets.Count
　　　　.Cells(N - 1, 1).Value = Worksheets(N).Name
　　　　.Cells(N - 1, 2).Value = _
　　　　Application.GetPhonetic(Worksheets(N).Name)
　　Next N
　　If UpDown <> 2 Then
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　　　Order1:=xlAscending, Header:=xlNo, OrderCustom:=1
　　Else
　　　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　　　Order1:=xlDescending, Header:=xlNo, OrderCustom:=1
　　End If
　　For N = 1 To .Range("A1").End(xlDown).Row
　　　　Worksheets(.Cells(N, 1).Text).Move After:=Sheets(N)
　　Next N
End With
For N = 2 To Worksheets.Count
　　If Worksheets(N).Visible = xlSheetVisible Then
　　　　Worksheets(N).Activate
　　　　Exit For
　　End If
Next N
Application.DisplayAlerts = False
Wwh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub

お礼

何度も回答していただきまして、本当にありがとうございました。私の説明不足でしたが、ご指摘のとおり、シート名が数字だけのものも含まれておりました。不十分な説明でかえってお手間取らせてすみませんでした。おかげさまで、#4の方法で希望どおりにできました。心よりお礼申し上げます。1000ポイントくらい差し上げたいのですが、そうもいかないので、気持ちだけもお送りします。ja7awuさん目指してもっと勉強しますです。ありがとうございました。m(__)m

回答No.3

ja7awu

シートの種類は、「ワークシート」だけですか。
「グラフ」や「MS Excel5.0ダイアログ」は含んでいませんよね。

それにしても、ちょっと考えにくいのですが・・・

もう一度やってみて、ダメなら次のコードでやってみてください。

もし、エラーになりましたら、黄色い行の　N にカーソルを当てると
数値が表示されますので　N > Sheet数　になっていないか確認してください。

Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Application.ScreenUpdating = False
Sheets.Add before:=Worksheets(1)
Set Wwh = ActiveSheet
ActiveWindow.SelectedSheets.Visible = False
With Wwh
　　For N = 2 To Worksheets.Count
　　　　.Cells(N - 1, 1).Value = Worksheets(N).Name
　　　　.Cells(N - 1, 2).Value = _
　　　　Application.GetPhonetic(Worksheets(N).Name)
　　Next N
　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1 '昇順
'　　.Range("A1").CurrentRegion.Sort Key1:=.Range("B1"), _
　　Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1 '降順
　　For N = 1 To .Range("A1").End(xlDown).Row
　　　　Worksheets(.Cells(N, 1).Value).Move after:=Worksheets(N)
　　Next N
End With
Worksheets(2).Select
Application.DisplayAlerts = False
Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub

回答No.2

ja7awu

シート名を「漢字読み順」で並べ替えるものとし、MS-IMEを使用している
ものとします。

一応、ご存知かも知れませんが、ＶＢＡの設定方法を書いておきます。

１．Alt + F11 で VBE(Visual Basic Editor)を開きます。
２．VBE のメニューから[挿入] -->[標準モジュール] を指定します。
３．モジュールウィンドウに下記コードをコピーして貼り付けます。
４．Alt + Q （または、右上隅の×）でウィンドウを閉じ、シートに戻ります。
５．実行するときは、Alt ＋ F8 (メニューから[ツール]-->[マクロ]-->
　　[マクロ])で「SortSheets」を指定し、[実行]ボタンを押します。

Sub SortSheets()
Dim Wwh As Worksheet
Dim N As Integer
Application.ScreenUpdating = False
Sheets.Add before:=Worksheets(1)
ActiveWindow.SelectedSheets.Visible = False
Set Wwh = ActiveSheet
For N = 2 To Worksheets.Count
　　Cells(N - 1, 1).Value = Worksheets(N).Name
　　Cells(N - 1, 2).Value = _
　　Application.GetPhonetic(Worksheets(N).Name)
Next N
Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
　　Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1 '昇順
'Range("A1").CurrentRegion.Sort Key1:=Range("B1"), _
　　Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1 '降順
For N = 1 To Range("A1").End(xlDown).Row
　　Worksheets(Wwh.Cells(N, 1).Value).Move after:=Sheets(N)
Next N
Worksheets(2).Select
Application.DisplayAlerts = False
Worksheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set Wwh = Nothing
End Sub

補足

ご丁寧な回答まことにありがとうございます。
ご指示どおりにやってみたのですが、次のエラーとなります。「実行時エラー'9'インデックスが有効範囲にありません。」
それで、デバッグを見たところ、次の行が黄色表示になっておりました。
Worksheets(Wwh.Cells(N, 1).Value).Move after:=Sheets(N)
度々恐れ入りますが、エラーの原因について教えていただけませんでしょうか?

回答No.1

noname#64217

Excelにはシートを並べ替える標準機能はありません。
多分「VBAならできます」という回答が出てくると思いますが。。。

1枚ずつ移動するのがいいです。初心者ならなおさらです((+_+))
がんばってください！