エクセルVBAについて（シート名前変更）

質問

sheet1に、
A1　●●店
A2　△△店
A3　■□店
　　↓
と、ずらーっと、名前の一覧があります。
同一ファイルに別名でシートが２０シートぐらいあって、そのシートの名前をsheet1の一覧から、自動で変更がしたいです。
初心者ですので、大変申し訳ございませんが、どなたかお教えください。よろしくお願いします。

回答No.2

kouzi_kouji · ベストアンサー

sheet1が　名前のリストでしたら、以下のようなコードで各Sheetの名前が付けられると思います。
kazuは、全シートの数です。
名前が書かれているシートは、item(1)ということになります。
実際に使われる時は、名前のリストのあるシートを選択状態で実行するか、cellsの前にWorksheets.Item(1).cells(i,1)として使って下さい。

kazu = Worksheets.Count
ReDim namae(kazu) As String

For i = 2 To kazu
Worksheets.Item(i).Name = Cells(i-1 , 1)

Next i

回答No.4

matsu_jun

みなさんのマクロを試した後で結構ですので、こちらも試してみてください。
一応
・シート名の書かれたシートは名前を変更しない
・シート名の書かれたシートの名前は「Sheet1」にこだわらない
・Sheet1に書かれたシート名が、シート名として利用してはいけない文字が
　使われていた場合や空白セルだった場合はメッセージを表示すると共に
　問題のセルまでカーソルが移動して、どのセルがおかしいかを示します。

他のシートのシート名が書かれたシートを表示させた状態で以下のマクロを
実行すればOKです。

マクロの貼り付け方と実行方法については、手前味噌ですが
http://okweb.jp/kotaeru.php3?q=1219526
のANo.2をご覧下さい。

'ここまで-------------------------------------------------------
Sub シート名一括変更()
If Worksheets.Count = 1 Then
MsgBox ("シートがありません")
Exit Sub
End If
i# = 1
j# = 1
On Error GoTo ERREND
Do While (i <= Worksheets.Count)
If Worksheets(i).Name <> ActiveSheet.Name Then
Worksheets(i).Name = ActiveSheet.Cells(j, 1).Value
j = j + 1
End If
i = i + 1
Loop
MsgBox ("シート名の変更が正常に完了しました")
Exit Sub
ERREND:
MsgBox Error(Err.Number)
ActiveSheet.Cells(j, 1).Select
End Sub
'ここまで-------------------------------------------------------

回答No.3

kaekaekaede

以下のでいかがでしょうか？

Option Explicit
Sub test()
Dim wb As Workbook
Dim wscont As Integer, l As Integer

Set wb = ThisWorkbook
wscont = wb.Worksheets.Count

For l = 1 To wscont
wb.Worksheets(l).Name = wb.Worksheets(1).Cells(l, 1).Value
Next

End Sub

回答No.1

KenKen_SP

A1の値をSheet1の名前に
A2の値をSheet2の名前に
A3の値をSheet3の名前に

などのように、規則性があれば簡単です。

しかし、上のような規則性がない、かつ既に各シートにデータが入力されている場合には工夫が必要です。

「Sheet2は●●店のデータ」などと「シートがどの店舗のデータなのか」を判別できるデータがどこかに入力されていますか？

また、A1 ●●店 の現在のシート名は？

お礼

ありがとうございます。
規則性はあります。各シートは、グラフ-1、グラフ-2、グラフ-3・・・・と、sheet1に記載されている名前分あります。
Sheet1の名前数＝シート数です。
よろしくお願いします。