Excelのシート名を任意のセルの情報にする

質問

お読みいただき有り難うございます。

任意のセルの入力内容をシートのタブ名に自動で反映されるようなことはできないでしょうか？
具体的には、例えばA1に「東京都」と入力すると、Sheet2のタブに「東京都」と反映され、B2に「大阪府」と入力するとSheet3のタブに「大阪府」と反映されるような物を考えています。
こんなことできるのでしょうか？

よろしくお願いします。

回答No.3

tom04 · ベストアンサー

こんにちは！

＞例えばA1に「東京都」と入力すると、Sheet2のタブに「東京都」と反映され、B2に「大阪府」と入力すると

入力するセルに規則性がないとなんとも致し方ないのですが・・・

A1　→　B2　セルではなく、　A1　→　B1　→　C1　・・・と1行目に入力するとします。
画面左下の「Sheet1」またはSheet見出しの一番左側のSheetが入力用のSheetとします。
そのSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストして1行目にSheet名にしたいデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim k As Long, cnt As Long, myFlg As Boolean
If Application.Intersect(Target, Rows(1)) Is Nothing Or Target.Count <> 1 Then Exit Sub
With Target
cnt = .Column + 1
If .Value <> "" Then
For k = 2 To Worksheets.Count
If Worksheets(k).Name = .Value Then
myFlg = True
Exit For
End If
Next k
If myFlg = True Then
MsgBox "同じシート名が存在します" & vbCrLf & "別のシート名を入力してください。"
.Select
Exit Sub
ElseIf cnt <= Worksheets.Count Then
Worksheets(cnt).Name = .Value
Else
Do Until Worksheets.Count = cnt
Worksheets.Add after:=Worksheets(Worksheets.Count)
Loop
Worksheets(Worksheets.Count).Name = .Value
End If
End If
End With
Worksheets(1).Activate
End Sub 'この行まで

※　あくまで一案です。m（_ _）m

補足

有り難うございます。
ぴったり意図通りです。実装にもう少しお知恵をお借りするかもしれないので、お礼入力はもう少しお待ちください。

回答No.5

MarcoRossiItaly

No.4 です、何度もすみません。No.4 のコード中、次の箇所を書き換えてください。理由は、文字列がおかしいというケース以外でも、キャンセルボタンを押したり不適格な番号を入力した場合にもメッセージが出てしまうことに対応するためです。

「"シート名に使えない文字列なので、シート名の変更を中止します。"」
↓
「"シート名の変更ができないので、中止します。シート名に使えない文字列が原因のこともあります。"」

お礼

何度もご回答いただき有り難うございました。

回答No.4

MarcoRossiItaly

質問文の解釈が難しいので仕方なく、下のコード書いてみました。セルの値を変更するとダイアログが出てくるので、そこに表示されているシートの番号からユーザーがキーボードで指定することで、そのシート名をセルに記入されている文字列に変更します。新しい名前を記入するセルがあるシートのシート見出しを右クリック、「コードの表示」から表示される画面に次のコードを貼り付けてください。

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim s As Worksheet
　　Dim n As String

　　If Target.Count > 1 Or Intersect(Target, Range("a1:c3")) Is Nothing Then Exit Sub
　　'「a1:c3」を「実際にシート名を記入するセル範囲」に上書き修正

　　If Target.Value = "" Then Exit Sub

　　With Target
　　　　For Each s In Worksheets
　　　　　　If s.Name = .Value Then
　　　　　　　　MsgBox "そのシート名は既存です。別シートにも同じ名前を付けることはできません。"
　　　　　　　　Exit Sub
　　　　　　End If
　　　　　　If n = "" Then
　　　　　　　　n = s.Name & "……" & s.Index
　　　　　　Else
　　　　　　　　n = n & vbCrLf & s.Name & "……" & s.Index
　　　　　　End If
　　　　Next s

　　　　On Error GoTo trap
　　　　Worksheets(Application.InputBox(prompt:="シートを選んでその番号を入力してください。" _
　　　　& vbCrLf & vbCrLf & n, Type:=1)).Name = .Value
　　End With
　　Exit Sub

trap:
　　MsgBox "シート名に使えない文字列なので、シート名の変更を中止します。"

End Sub

お礼

ご回答、有り難うございました。
心より感謝いたします。今回は私の質問のしかたが悪く、混乱させてしまったようです。申し訳ありません。No.3の方のご回答が今回の私の意図通りです。
ご回答いただいたことに、心より感謝いたします。

回答No.2

keithin

次の通りに作成します。

手順：
１枚目のシートのＡ１セルに「目次」と記入しておく
シート名タブを右クリックしてコードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

private sub Worksheet_Change(byval Target as excel.range)
　dim h as range
　on error resume next
　for each h in application.intersect(target, range("A:A"))
　　worksheets(h.row).name = h.value
　next
end sub

ファイルメニューから終了してエクセルに戻る
Ａ２以下のセルに記入する。

＃補足
＞任意のセルの入力内容を

任意のセルじゃ、その内容をどのシートに当てたらいいのか判りません。

お礼

ご回答、有り難うございました。
心より感謝いたします。今回は私の質問のしかたが悪く、混乱させてしまったようです。申し訳ありません。No.3の方のご回答が今回の私の意図通りです。
ご回答いただいたことに、心より感謝いたします。

回答No.1

Gracies

ここでは２００７のエクセルで説明します。
(1)ホームの右側の校閲の隣の表示を、クリック
(2)その中の、ページレイアウトを、ダブルクリック
⇒別ページが表示される　ＢＯＯＫ１
(3)Ｂｏｏｋ１の下のシート１をクリック⇒シート１が、白くなっていることを確認
(4)コントロールキーを
押しながら、シート２をクリック（白くなったことを確認）すると、Ｂｏｏｋ１[作業グループ]と表示される
(5)シート１のＡ１に東京都と入力すると、シート２にも、入力されている。
(6)シート２をクリックして、コントロールキーを押しながら、シート３をクリックすると、作業クループと、左上に表示される
(7)シート２のＢ２に大阪府と入力するとシート３のＢ２に、大阪府と書かれている。
(8)シート１をクリックして、コントロールキーを押しながら、シート２とシート３をクリックすると、作業グループと表示される
(9)シート１の東京都と大阪府を含むところに、罫線で囲うと、シート１～３まで、罫線が引ける。
以下、色をつけることも可能！

☆☆☆注意点：シートをクリックをした時に、シートの色が白くなっていることを確認すること。☆☆☆

お礼

ご回答、有り難うございました。
心より感謝いたします。今回は私の質問のしかたが悪く、混乱させてしまったようです。申し訳ありません。No.3の方のご回答が今回の私の意図通りです。
ご回答いただいたことに、心より感謝いたします。