エクセル 複数シートのフィルタオプションをマクロで更新したい

複数シートのフィルタオプションをマクロで更新したい。

ブックの中に[データ]シート(日々の販売データ)と月別集計シート(4か月分程度を予定)があります。
集計用シート名は[syuukei_201601]・[syuukei_201602]…と設定しています。

[データ]シートから日付・担当者・品目など複数の条件でフィルタオプションを設定し[syuukei_xx]シートに抽出しました。

月別集計シートは、1行目はフィルタ条件の項目を設定。フィルタの条件はORとAND
で複数条件の場合もあるため、2～9行目までを条件入力の欄に設定しました。
(月によって条件が変わります。)
フィルタの結果は11行目以降に抽出しました。

[データ]シートが更新された場合、それぞれの月別シートをマクロで更新したいと思っています。
特定のシートのみを更新する方法は、ネットで調べ、下記のように設定しました。
[syuukei_201601]シートを更新するマクロです。
----------------------------------------------------------

Sub フィルタオプションテスト()
　　'11行目以降の既存データを削除
Sheets("syuukei_201601").Select
ActiveWindow.Panes(3).Activate
Rows("11:11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveWindow.Panes(1).Activate
Range("A1").Select

　　Dim myData As Range
Dim myCriteria As Range

Set myData = Worksheets("データ").Range("A1").CurrentRegion
Set myCriteria = Worksheets("syuukei_201601").Range("A1").CurrentRegion

With Worksheets("syuukei_201601")
myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria, _
CopyToRange:=.Range("A11"), Unique:=False
End With
End Sub
----------------------------------------------------------
このマクロをブック内のその他のシートにも一度に実行するには、どのように変更したら良いのでしょうか？

シートを複数選択してマクロを実行する方法は、見つけられたのですが、
上記のマクロですとシート名が指定されているため実行できません。
"syuukei_201601"の部分をシート名(数)に合わせて可変にしたいです。

(VBAは、ほぼ素人です。コードの意味を調べながら理解できる程度です。)

複数シートにマクロを適用する方法をご教示ください。
分かりづらい部分は、ご質問ください。

質問者からの補足コメント

• ご回答いただき、ありがとうございます。
  
  ご回答いただいた、マクロを実行してみましたが、エラーが表示されました。
  
  「コンパイルエラー：
  End With に対応する With がありません。」
  下から5行目に
  With Worksheets("データ")　を追加しました。
  
  最初に設定したシートでは、正常に動作しますが、他のシートではエラーが表示されます。
  「実行時エラー '1004':
  Pane クラスの Activate メソッドが失敗しました。」
  【デバック】ボタンをクリックすると、1行目の
  ActiveWindow.Panes(3).Activate
  がハイライトされます。
  
  修正方法をご教示ください。
  よろしくお願いいたします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2016/02/17 15:38

• 

  ご回答いただき、ありがとうございます。
  ご教示いただいた方法で修正し、シート名を指定すれば連続して更新が可能となりました。
  
  「特定シートマクロ」から「フィルタオプションテスト」マクロを呼び出して実行しています。
  「フィルタオプションテスト」はご教示ただいた内容とほぼ同じです。
  シートを指定して更新はできたのですが、[syuusei_XX]シートのみ更新する方法がわかりません。
  <>や*を使ってみたのですが、ダメでした。
  宜しければご教示ください。
  --
  Sub 特定シート()
  For Each st In Worksheets
  Select Case st.Name
  Case "syuukei_1601", "syuukei_1602"
  st.Activate
  Call フィルタオプションテスト
  End Select
  Next
  End Sub

  No.2の回答に寄せられた補足コメントです。 補足日時：2016/02/19 13:30

• 

  ご回答いただき、ありがとうございます。
  ご教示いただいたマクロを実行したところ、下記のエラーメッセージが表示されました。
  「実行時エラー '9'
  インデックスが有効範囲にありません。」
  デバックをクリックすると
  「Set myCriteria = Worksheets(MySyuukei).Range("A1").CurrentRegion」
  がハイライトされています。
  
  修正方法がございましたら、ご教示ください。

  No.3の回答に寄せられた補足コメントです。 補足日時：2016/02/19 13:39

• いろいろ試していたら間違えてしまいました。
  分かり辛くてすみません。
  抽出するシート名は[syuukei_201601]•[syuukei_201602]と西暦4桁+月2桁です。
  失礼いたしました。
  よろしくお願いいたします。

  No.4の回答に寄せられた補足コメントです。 補足日時：2016/02/19 22:45

• ご回答いただき、ありがとうございます。
  ご教示いただいた、「syuukei_」で始まるシートのみを更新するマクロを試してみたのですが、
  何も更新されませんでした。
  同じ環境でシート名を指定したマクロ[特定シート]は正常に動作しました。
  何か違っていますか？
  教えていただいたのは、[特定シート_可変]と名前を付けました。
  
  画像を添付いたします。アドバイスいただければ、幸いです。

  
  No.5の回答に寄せられた補足コメントです。 補足日時：2016/02/22 13:22

No.6 ベストアンサー 回答者： ママチャリ 回答日時： 2016/02/22 20:23

画像ではよくわからないのですが、次の行の　syuukei_　の前に空白がひとつ入ってしまっていました。

ごめんなさい。

誤）If Left(st.Name,8) = " syuukei_" then
正）If Left(st.Name,8) = "syuukei_" then

それでもだめなら、画像ではなく、プログラムコードをペーストしてください。

この回答へのお礼

ママチャリさま
ご回答いただき、ありがとうございます。
ご教示いただいたコードで正常に動作いたしました。

思い通りの集計ができうれしいです。
この度は、何度もお答えいただき、ありがとうございました。

こちらの集計作業は、まだ続くため、また質問させていただく場合が、ございます。
お時間がございましたら、ご回答いただければと思います。

本当にありがとうございました。

お礼日時：2016/02/23 09:56

No.5 回答者： ママチャリ 回答日時： 2016/02/20 20:30

私ならこうします。

（シート名が、" syuukei_"で始まるシートを対象とする）

Sub 特定シート()
For Each st In Worksheets
If Left(st.Name,8) = " syuukei_" then
st.Activate
Call フィルタオプションテスト
End If
Next
End Sub

No.4 回答者： ママチャリ 回答日時： 2016/02/19 20:38

nananeko5555さんの書いた文書の中に、下記のようなシート名が記載されていますが、どれが正解ですか？

[syuukei_201601]・[syuukei_201602]
[syuukei_xx]……XXは2桁？
[syuusei_XX]……修正？
Case "syuukei_1601", "syuukei_1602"･･･…年月は4桁？

No.3 回答者： ママチャリ 回答日時： 2016/02/17 20:50

こんな感じです。

事前に、syuukeiシートの行を削除していますが、必要ありません。

Sub test()
Call フィルタオプションテスト("syuukei_201601")
Call フィルタオプションテスト("syuukei_201602")
Call フィルタオプションテスト("syuukei_201603")
Call フィルタオプションテスト("syuukei_201604")
End Sub

Sub フィルタオプションテスト(MySyuukei As String)
'11行目以降の既存データを削除
Dim myData As Range
Dim myCriteria As Range
Dim myCopyTo As Range

Set myData = Worksheets("データ").Range("A1").CurrentRegion
Set myCriteria = Worksheets(MySyuukei).Range("A1").CurrentRegion
Set myCopyTo = Worksheets(MySyuukei).Range("A11").CurrentRegion

Application.DisplayAlerts = False ’これを入れとかないとコーションが表示される場合があります。
myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria, _
CopyToRange:=myCopyTo, Unique:=False
Application.DisplayAlerts = True
End Sub

No.2 回答者： hallo-2007 回答日時： 2016/02/17 15:54

NO1です。

失礼しました。最後のEndWithを消し忘れました。
ActiveWindow.Panes(1).Activate　も不要では？
作成されたのが貴方なので、何が必要かよく考えてください。
思いつく部分ですが
Sub フィルタオプションテスト()
Rows("11:11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp

Dim myData As Range
Dim myCriteria As Range
Set myData = Worksheets("データ").Range("A1").CurrentRegion
Set myCriteria = Range("A1").CurrentRegion
myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria, _
CopyToRange:=Range("A11"), Unique:=False
End Sub

では？

Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
も
Range(Selection, Selection.End(xlDown)).ClearContents
に置き換えられると思う。

No.1 回答者： hallo-2007 回答日時： 2016/02/17 13:06

>複数シートにマクロを適用する方法をご教示ください。

たぶんに、シート名も毎月変化するのですよね。
抽出する条件などの作業も発生しますよね。
考え方ですが
１、シート名や条件を入力作業を行う。
２、作業を行った集計用シートからマクロを実行する。
３、ほかのシートでも同様、４回繰り返す。
これで十分では
そのためには

Sub フィルタオプションテスト()
ActiveWindow.Panes(3).Activate
Rows("11:11").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveWindow.Panes(1).Activate
Range("A1").Select

Dim myData As Range
Dim myCriteria As Range

Set myData = Worksheets("データ").Range("A1").CurrentRegion
Set myCriteria = Range("A1").CurrentRegion

myData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=myCriteria, _
CopyToRange:=Range("A11"), Unique:=False
End With
End Sub

と不要な部分を削除したVBAを実行させては如何でしょうか。