マクロ 複数のシートに適用する記述がわかりません

質問

いつも皆様方にはたいへんお世話になっております。

下記のマクロをシート３～３３（同じ構造です）まで、適用したいのですが、一つ一つのシートに貼り付けていけばよいのですが、なんとか一つの記述で出来ないかと、以前この質問コーナーでの回答を寄せ集めて、記述したのですが、コンパイルエラーばかりで、どうにもなりません。
こんな初歩的なことは、最小限の勉強で解決出来るのかも知れませんが、どうにもなりません。
誠に恐縮ですが、下記の記述の「どこを」「どの様に」修正したらよいか、どなたか解る方、教えて頂けないでしょうか。

どうぞ、よろしくお願いいたします。

Private Sub worksheet_change(ByVal Target As Excel.Range)
Dim sheetno As Integer　　　　　　　　　　←この３行を当てずっぽうで挿入してみました＞＜；
For sheetno = 3 To 33
Worksheets(sheetno).Select
h As Range
Set Target = Application.Intersect(Target, Range("E5:N12, E14:N22, E24:N28, E30:N34"))

On Error Resume Next
For Each h In Target
If h <> "" Then
Application.EnableEvents = False
h = Application.VLookup(h.Value, Worksheets("マクロリスト表").Range("A:B"), 2, False)
Application.EnableEvents = True
End If
Next
End Sub

回答No.2

keithin · ベストアンサー

同じマクロをダブって登録はできませんので，それではこの方法は使えません。
諦めて各シートに元のマクロを登録する方法に戻すか，またはこれまでThisWorkbookに登録していたWorkbook_Sheetchangeマクロを消して（＝それを別のやり方に変えて）今回のマクロを使うか，または，がんばって２つのマクロの機能を１つのマクロに統合してください。

がんばって２つのマクロの機能を１つのマクロに統合するとは，つまり「具体的に」どんなシート構成にしていて，「具体的に」どんなシート名が並んでいて，どのシートでは何をしたい，そういったあなたのヤリタイ具体的な作業に照らして，適切にマクロの書きぶりを修正するということです。

お礼

いつも、ご回答いただきありがとうございます。

せっかく、お手数をおかけしましたが、今回は各シートに元のマクロを登録することで、当面の解決策といたします。
しかし、２つを統合する方事が出来るなら、コツコツとちゃれんじして見ようと思っています。ありがとう、ございました。

回答No.1

keithin

各シートのシート名タブ右クリックでコードの表示で表示したシートのマクロは「全て消去しておく」
ＶＢＥ画面でプロジェクトエクスプローラから，当該のブックに含まれている「ThisWorkbook」モジュールをＷクリックする
現れたシートに下記をコピー貼り付ける

private sub Workbook_SheetChange(byval Sh as object, byval Target as excel.range)
　if sh.index < 3 or sh.index > 33 then exit sub
　set target = application.intersect(target, sh.range("E5:N12,E14:N22,E24:N28,E30:N34"))
　if target is nothing then exit sub
　on error resume next

　for each h in target
　　if h <> "" then
　　　application.enableevents = false
　　　h.value = application.worksheetfunction.vlookup(h.value, worksheets("マクロリスト表").range("A:B"), 2, false)
　　　application.enableevents = true
　　end if
　next
end sub

ファイルメニューから終了してエクセルに戻る
３～３３枚目のシートの所定のセルに記入すると，「そのシートに限り」書き換える。

＃捕捉
「３～３３枚目のシート」とは，シート名タブを左から数えて１枚目，２枚目，３枚目という意味です。
シート名ではないので間違えないように気をつけてください。

補足

早速、お答え頂きましてありがとうございます。
ご指示にしたがい実行しましたところ、

コンパイルエラー　
名前が適切ではありません：Workbook_SheetChange

と出まして、ヘルプを見ますと

名前が適切ではありません。
識別子が別の識別子と競合しているか、または修飾が必要です。・・・
と書かれています。

下記のように、先に同じシート範囲にマクロがあり、重複してしまったせいでしょうか？

最初に、「ThisWorkbook」モジュールのすでに下記の様なマクロがあることを、記入するべきでした。
私の知識があまりにも初心者過ぎて、何に留意して質問したらよいか、今ひとつつかめなくて、ご迷惑をおかけしております。

お忙しいところ、申し訳ありませんが、対処法をお教え願えないでしょうか。
よろしくお願いいたします。

先にあったマクロ
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
If Sh.Name = "勤務表" Or Sh.Name = "勤務表データ" Or Sh.Name = "マクロリスト表" Or Sh.Name = "マニュアル" Or Sh.Name = "データシート" Then Exit Sub
If Target.Address <> "$U$1" Then Exit Sub '以前やったとおり、マクロをトリガする「実入力セル」の番地を記載する事
If Sh.Range("$U$1") = "" Then Exit Sub

On Error GoTo errhandle
Sh.Name = Sh.Range("$U$1").Text
Exit Sub

errhandle:
MsgBox "BAD SHEET NAME"

End Sub

今回のマクロ
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
If Sh.Index < 3 Or Sh.Index > 33 Then Exit Sub
Set Target = Application.Intersect(Target, Sh.Range("E5:N12,E14:N22,E24:N28,E30:N34"))
If Target Is Nothing Then Exit Sub
On Error Resume Next

For Each h In Target
If h <> "" Then
Application.EnableEvents = False
h.Value = Application.WorksheetFunction.VLookup(h.Value, Worksheets("マクロリスト表").Range("A:B"), 2, False)
Application.EnableEvents = True
End If
Next
End Sub