エクセルVBAでシートの並び替え

質問

エクセル２０００です。
バラバラの名前をもつ30枚ほどのシートの順番を、並び替えたいのです。
並び順は新たに挿入したsheets("目次")のB2からB32に記載の名前の順です。

シートを並び替えるマクロは思いつきません。
よろしくお願いします。

回答No.1

maruru01 · ベストアンサー

こんにちは。maruru01です。

こんな感じ

Sub Macro1()

　　Dim i As Long

　　For i = 2 To 32
　　　　Sheets(Sheets("目次").Cells(i, 2).Value).Move After:=Sheets(i - 1)
　　Next i

End Sub

なお、セルのシート名と実際のシート名が違う場合のエラー処理を付け加えておいて下さい。

お礼

さっそくありがとうございました。
うまく出来ました。
助かりました。

回答No.3

imogasi

目次のシートを一番右に持ってきておく。
B2からB32まで３１枚＋目次一枚＝３４枚として
Sub test01()
N = ActiveWorkbook.Worksheets.Count
na = Worksheets("sheet7").Cells(2, "B")
Sheets(na).Move before:=Sheets(1)
For i = 3 To N - 1
na = Worksheets("sheet7").Cells(i, "B")
Sheets(na).Move after:=Sheets(i - 1)
Next i
End Sub

お礼

ありがとうございました。

皆様のお教えをもとに下記のようなVBAがしあがりました。
目次と各ページの間にリンクも貼れました。
ありがとうございました。

Sub シート並べ替えとリンク()

Dim i As Long
With Sheets("目次")
.Hyperlinks.Delete
.Move before:=Sheets(1)
For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row

Set ws = Sheets(.Cells(i, 2).Value)
ws.Move after:=Sheets(i - 1)
On Error GoTo MSG
ws.Cells(1, 1).Value = "目次"
ws.Hyperlinks.Add Anchor:=ws.Cells(1, 1), Address:="", SubAddress:=Sheets(1).Name & "!A1"
.Hyperlinks.Add Anchor:=.Cells(i, 2), Address:="", SubAddress:=Sheets(i).Name & "!A1"
Next i
.Activate
Exit Sub

MSG: MsgBox .Cells(i, 2).Value & "シートが見当たりません。"
End With

End Sub

回答No.2

jindon

こんなのもあります。
目次シートを最初に持ってきて、後ろに並べ替えます。

Sub Sheet_Sort()
Dim i As Integer, ws As Worksheet, wsI As Worksheet

Set wsI = Sheets("目次")

For i = wsI.Range("B65536").End(xlUp).Row To 2 Step -1

Sheets(wsI.Range("B" & i).Value).Move after:=wsI

Next

Sheets(1).Select
Set wsI = Nothing
End Sub

お礼

ありがとうございました。
なるほど、最後から順にやるやり方ですね、これは勉強になりました。