セル入力しているデータをシート名に一括変換する方法

質問

エクセルにてセル入力しているデータをシート名にするためにネットで検索をかけ以下のマクロが掲載されていました。

Sub SheetName()
　　ActiveSheet.Name = ActiveSheet.Range("B2")
End Sub

このマクロを全シート一括で行いたいのですが、どのようにすればよいのでしょうか？

お教え願います。

回答No.4

NuboChan · ベストアンサー

No1です。

>ただしその後、×印 400とエラーメッセージがでてきました。

Sub test2()が原因では無いと思います。

難しいコードは初心者の私では理解できませんが
まだ、明かされていないコードが有るのではないですか？

初心者がアドバイスできる領域ではなさそうなので私は退席します。

お礼

お礼が遅くなりました。
頂きましたアドバイスにて現在上手くいっております。
ありがとうございます。

回答No.5

imogasi

#3です。補足を見て、
この質問は、そもそも、
（１）多数の、既存のシートの名前を、それぞれの適当な、名前に変えたい
のか
（２）新しく、シーとを追加して、それぞれ望む名前のシート名を付けたいのか
はっきり、質問で、言えてない。
そういうレベル（エクセル的に必要な）状態を意識して、説明できない）では、まだVBAを本格的にやれることではない。
手動操作でやって、マクロの記録でもとる、しかないだろう。
後者でやって見ると、
Sub Macro1()
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Select
Sheets("Sheet3").Name = "abc"
End Sub
のようになった。
たまたまＳｈｅｅｔ１、Ｓｈｅｅｔ２しかない状態で、上記（２）操作した場合です。

回答No.3

imogasi

質問の
>全シート一括で行いたい
どういうこと？シート(名）はバラバラか？であれば、各シート名はどういう風に指定するのか？
セルのデータ例でも書かないと、回答に苦労する。
＞一括で行い
一括では行えないのでは？シートごと、またはセルごとの、繰り返しの実行になるのでは。
「一括」という言葉で何が言いたい？
VBAでは複数のものを、１行のコードの実行で出来るケースは(コレクション的なものの、抹消的なもの、書式設定的なものを除き）、殆ど無いように思うが。
ーー
質問の表現がまずくて、別のことを考えさせられている気がする。
ーー
丁寧に説明（補足）すること。

補足

以下では　？

Sub test()

Dim Ws As Worksheet

For Each Ws In Worksheets
Ws.Name = Ws.Range("B2")
End Sub

上記では

コンパイルエラー

Forに対するNEXTがありませんとあり、上手くできませんでした。

回答No.2

NuboChan

すいません。
nextが抜けていました。

Sub test2()

Dim Ws As Worksheet

For Each Ws In Worksheets
Ws.Name = Ws.Range("B2")
next　

End Sub

それだけのコードを書ける人がエラーが特定できないわけは無いと思いますが
他の人が書いたコードでしょうか？

補足

こんにちは。
返事が遅くなりました。

こちらで実践してみたところ全シート一括で指定されたセルの文字にシート名が変更されました。

ただしその後、×印 400とエラーメッセージがでてきました。
閉じれば問題ありません。

エクセルではオプションでマクロの有効にチェックをいれてありますが、変ですね？？？

メッセージ以外ではちゃんと使えてますので助かってます。

ありがとうございます。

回答No.1

NuboChan

以下では　？

Sub test()

Dim Ws As Worksheet

For Each Ws In Worksheets
Ws.Name = Ws.Range("B2")
End Sub

補足

VBAで他に下記のようなコードが記載済みになっております
-----------------------------------------------------------------------
Sub test()
Dim i As Long, j As Long

j = 2

For i = 1 To Sheets.Count
If Sheets(i).Name <> "一覧" Then
Sheets("一覧").Cells(j, "B").Value = Sheets(i).Range("E2").Value
Sheets("一覧").Cells(j, "C").Value = Sheets(i).Range("I6").Value
Sheets("一覧").Cells(j, "D").Value = Sheets(i).Range("I10").Value
Sheets("一覧").Cells(j, "E").Value = Sheets(i).Range("AQ12").Value
Sheets("一覧").Cells(j, "F").Value = Sheets(i).Range("AQ11").Value
j = j + 1
End If
Next
End Sub

Private Sub Workbook_Open()
Dim R As Long, C As Integer, S As Integer
Const ActCell = "A1" ' <-- 開いたときアクティブにし、
'　　　　　　　　　　　　　　ウィンドウ左上にするセルを指定します。
R = Range(ActCell).Row
C = Range(ActCell).Column
For S = 1 To Worksheets.Count
Worksheets(S).Select
Range(ActCell).Activate
ActiveWindow.ScrollRow = R
ActiveWindow.ScrollColumn = C
Next S
Worksheets(1).Select
End Sub
-----------------------------------------------------------------------
上記にアドバイス頂きましたものを追加すると

Sub test()

Dim Ws As Worksheet

For Each Ws In Worksheets
Ws.Name = Ws.Range("B2")
End Sub

以下のエラーが表示されます。

コンパイルエラー
forに対応するNextがありません

何が原因かおわかりでしょうか？