EXCEL2003 VBAについて

EXCEL2003 VBAについて

EXCEL2003で12個の同じ体裁の複数シートで構成されたブックがあります。
(1)シート1の[A1]に数値を入力するとシート名に文字列で構成された[E1]セルの内容を反映させる
(2)シート2～12の[A1]セルにはシート1[A1]の値が入る
(3)シート2～12にも[E1]の内容がシート名に反映される・・・はず
(4)　(1)処理時に自動的に(3)の処理が行われず、シート2～12に関しては、手動でA1をダブルクリックした後ESCキーでキャンセルし、シート名を更新しています。

しかしこの方法ですとこれをシート2～12全てでやらなければなりません。
(1)の入力だけで(2)を自動更新させる方法についてアドバイス頂けないでしょうか。
どうぞよろしくお願いします。


Sheet内スクリプト

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ERR:
If Target.Cells(1, 1).Address = "$A$1" Then
Me.Name = Cells(1, 5)
End If
Target.Cells(1, 1).Select
Exit Sub
ERR:
MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR"
Resume Next
End Sub

No.2 ベストアンサー 回答者： nda23 回答日時： 2010/10/08 15:37

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

'★A1セル以外なら何もしないで終了
If Target.Cells(1, 1).Address <> "$A$1" Then Exit Sub

Dim 値, シート, I, シート数, 名, エラー
値 = Me.Cells(1, 5)
シート数 = ThisWorkbook.Worksheets.Count
'★全シートに同じ処理を行う
For I = 1 To シート数
　　　　'★ｎ番目のシートを対象にする
　　　　Set シート = ThisWorkbook.Worksheets(I)
　　　　'★A1セルに値を設定
　　　　シート.Cells(1, 1) = 値
　　　　名 = シート.Cells(1, 5)
　　　　On Error Resume Next
　　　　'★シート名を変更
　　　　シート.Name = 名
　　　　'★エラー状態を記録
　　　　エラー = err.Number
　　　　On Error GoTo 0
　　　　'★エラーが発生した場合はメッセージボックスを表示
　　　　If エラー <> vbNormal Then
　　　　　　　　MsgBox 名 & "には変更できません", vbCritical, "ERROR"
　　　　End If
Next
Me.Cells(1, 1).Select
End Sub

この回答へのお礼

ありがとうございます。
下部を修正し、問題が解決しました。
'★A1セルに値を設定
'シート.Cells(1, 1) = 値

お礼日時：2010/10/08 15:58

No.1 回答者： tohru999 回答日時： 2010/10/08 15:36

>>(1)シート1の[A1]に数値を入力するとシート名に文字列で構成された[E1]セルの内容を反映させる

>>(3)シート2～12にも[E1]の内容がシート名に反映される・・・はず
説明がよくわかりません。
(1) シート1のE1セルにある文字列 -> シート1の名前に設定
は、わかりましたが、
(3) の説明だと、シート2～12の名前もシート1の名前(シート1のE1セルの文字列)に設定
になりますよね。
同じ名前のシート名が12個になります。(実際はエラーとなりますが)

もしかして、私の勘違い？
正しいのは下の説明？
(3)シート2～12 それぞれ [E1]セルからシート名を設定

この回答への補足

(3)シート2～12 それぞれ [E1]セルからシート名を設定
ご指摘の通り、上記表現が正しいです。

よろしくお願いします。

補足日時：2010/10/08 15:54