EXCEL シート名を自動変更するマクロ

質問

いつも御世話になっています。

質問内容ですが、特定セルに入力した値を特定のシート名に反映させるマクロについてです。

例えば、
Sheet1のセルA1に「会議室」と入力した場合、Sheet5のシート名が「会議室」となり、
Sheet1のセルA2に「休養室」と入力した場合、Sheet7のシート名が「休養室」となる。
というようなものです。
（※Sheet番号は連番になっていません）

なお、シート名変更用の入力シートはSheet1のみです。

できれば、各シート名を変更する際、以下のようにしたいと考えています。

Sheet5　元シート名：負荷計算(1)
　　　　　　　　　　　↓
Sheet5　変更後シート名："Sheet1のA1で入力した名前" 負荷計算

教えて頂けると助かります。
宜しくお願いします。

回答No.4

tom04 · ベストアンサー

こんにちは！
一例です。

＞（※Sheet番号は連番になっていません）
とありますが、Sheet見出し上で左からSheet1・Sheet2・・・の順とします。
すなわちSheet5はSheet見出しで左から5番目のSheet
Sheet7は左から7番目のSheetという前提です。

画面左下のSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてSheet1のA1・A2セルにデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Long, myFlg As Boolean
If Application.Intersect(Target, Range("A1:A2")) Is Nothing Or Target.Count <> 1 Then Exit Sub
On Error Resume Next
With Target
For k = 1 To Worksheets.Count
If Worksheets(k).Name = .Value Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
MsgBox "シート名が重複します。" & vbCrLf & "別のシート名を入力してください。"
.Value = ""
.Select
Exit Sub
Else
If .Address = "$A$1" Then
Worksheets(5).Name = .Value
Else
Worksheets(7).Name = .Value
End If
End If
End With
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

ありがとうございます、非常に助かりました。

回答No.3

tsubuyuki

なかなか意図が読み取りづらい質問ですね。

とりあえず
> Sheet1のセルA1に「会議室」と入力した場合
> Sheet5のシート名が「会議室」となり
> Sheet1のセルA2に「休養室」と入力した場合
> Sheet7のシート名が「休養室」となる
> Sheet番号は連番になっていません
勝手に読み替えます。
・一番左のシートのＡ１が（以下略）
　→左から５番目のシート名が（以下略）
・一番左のシートのＡ２が（以下略）
　→左から７番目のシート名が（以下略）
と言うことであり、
Sheet1のＡ１・Ａ２セルを入力してからマクロを走らせる、
と言う処理を「使用者の意思で」走らせるのであれば単純に

Sub Sample1()
　　　　If Sheets(1).Range("A1") <> "" Then
　　　　　　　　Sheets(5).Name = Sheets(1).Range("A1")
　　　　End If
　　　　If Sheets(1).Range("A2") <> "" Then
　　　　　　　　Sheets(7).Name = Sheets(1).Range("A2")
　　　　End If
End Sub

で５番目・７番目のシート名を変えてやれば事足ります。
ただし、既にその「入力された値と同じシート名」があるとエラーで止まります。
トラップをかけるのは簡単ですが、そんな必要は無さそうです。
処理タイミングにもよりますが、この程度の処理なら「手作業で」変更した方が早いですし、
「手作業で」変更しても同じようにエラーで止まりますから。

これが「Sheet1のＡ１が入力されたらSheet5の名前を」
あるいは「Sheet1のＡ２が入力されたらSheet7の名前を」
と言う処理を「使用者の意思に関わらず、該当セルに入力されたら」走らせるのであれば、

Private Sub Worksheet_Change(ByVal Target As Range)
　　　　If Target = Sheets(1).Range("A1") Then
　　　　　　　　Sheets(5).Name = Sheets(1).Range("A1")
　　　　End If
　　　　If Target = Sheets(1).Range("A2") Then
　　　　　　　　Sheets(7).Name = Sheets(1).Range("A2")
　　　　End If
End Sub

こんな感じのモノをSheet1モジュールに書く必要があります。
ただしこの場合は「値が空白ではない・同じ名前のシートが存在しない」などの
エラー処理が必要かもしれませんが、ここでは割愛します。
これでも「手作業で」変更した方が早いでしょうから。

さてさて。
> Sheet5　元シート名：負荷計算(1)
> 　　　　　　　　　　　↓
> Sheet5　変更後シート名："Sheet1のA1で入力した名前" 負荷計算
これが、「“負荷計算(1)”と言うシートを探して」と言う意味だとしたら
まったく条件が変わっていますよね？
まぁ、聞くまでも無く本題はコチラなのでしょうけれど。

Sub Sample2
Dim WS As Worksheet

　　　　If Sheets(1).Range("A1") <> "" Then
　　　　　　　　For Each WS In Worksheets
　　　　　　　　　　　　If WS.Name = "負荷計算(1)" Then
　　　　　　　　　　　　　　　　WS.Name = Sheets(1).Range("A1") & "負荷計算"
　　　　　　　　　　　　End If
　　　　　　　　Next
　　　　End If
End Sub

または

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS As Worksheet

　　　　If Target = Sheets(1).Range("A1") Then
　　　　　　　　For Each WS In Worksheets
　　　　　　　　　　　　If WS.Name = "負荷計算(1)" Then
　　　　　　　　　　　　　　　　WS.Name = Sheets(1).Range("A1") & "負荷計算"
　　　　　　　　　　　　End If
　　　　　　　　Next
　　　　End If
End Sub

このくらいが解りやすいのではないかと思います。
それでも「手作業」のほうが早くて確実かもしれません。

ちなみに、
　　　　Sheets("負荷計算(1)").Name = （略）
として、直接変更してやるのも手段の一つでしょうが、
名前を変更したい元のシートが無かったらエラーで止まります。
「無い場合に警告を出す」などのエラー処理を考えているのであれば
コチラの方が有効かもしれません。

細かい解説は割愛しますが、あとは適宜応用下さい。

お礼

ありがとうございます、参考にさせて頂きます。

回答No.2

misatoanna

シートの名前(タブに表示されている名前)を変更する記述です。
・左から何枚目のシートかを指定して変更する場合　Sheets(5).Name = "変更後の名前"
・シートのオブジェクト名を指定して変更する場合　Sheet5.Name = "変更後の名前"
・直接シート名を指定して変更する場合　　　　　　Sheets("変更前の名前") = "変更後の名前"

ご質問の場合は、VBE画面の左側ツリー(下図)を確認し、当該シートのオブジェクト名を使って変更されればよいと思います。
Sheet5.Name = Range("A1").Value
Sheet7.Name = Range("A2").Value

お礼

ありがとうございます。
参考にさせて頂きます。

回答No.1

K Kazz（@JazzCorp）

Sheet1
A列：変更前シート名
B列：変更後シート名（ぷりフィックス）

Option Explicit
Sub ReNameRobo()
Const xName = "Sheet1"
Dim xSheet As Worksheet
Dim zSheet As Worksheet
Dim xLast As Long
Dim nn As Long
Set zSheet = Worksheets(xName)
zSheet.Columns("C").ClearContents
xLast = zSheet.Cells(Rows.Count, "A").End(xlUp).Row
For nn = 1 To xLast
If Not IsEmpty(zSheet.Cells(nn, "A")) And Not IsEmpty(zSheet.Cells(nn, "B")) Then
For Each xSheet In Sheets
If (xSheet.Name = zSheet.Cells(nn, "A").Value) And (xSheet.Name <> xName) Then
xSheet.Name = zSheet.Cells(nn, "B").Value & " " & xSheet.Name
zSheet.Cells(nn, "C").Value = xSheet.Name
End If
Next
End If
If IsEmpty(zSheet.Cells(nn, "C")) Then
zSheet.Cells(nn, "C").Value = "×"
End If
Next
zSheet.Select
zSheet.Columns("C").AutoFit
End Sub

お礼

ありがとうございます。
参考にさせて頂きます。