マクロ！一覧から別シートへの抽出

商品の納期や、集金日などが一覧になっている【一覧】シートがあります。
他に集金月別にシート【4月】【5月】…と一年分12シートあります。

一覧シートは、空欄セルに店舗名や納期などを随時入力していき、データは増えていくのみです。
下記のマクロでデータの抽出・抽出結果のコピー・貼り付けを行っています。

Sub Macro4()
'
' Macro4 Macro
' 集金月で抽出

Dim myRow1 As Long, myRow2 As Long
myRow1 = Sheets("一覧").Range("B65536").End(xlUp).Row
myRow2 = Sheets("4月").Range("B65536").End(xlUp).Row

If myRow2 >= 3 Then
★ Sheets("4月").Range("A3:P" & myRow2).ClearContents
End If

Sheets("一覧").Range("A3:P" & myRow1).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("G1:H2"), CopyToRange:=Range("A4:P4"), Unique:=False
End Sub

一覧以外のシート全てに、上記マクロを登録した【抽出】ボタンを設置し
G1:H1セルには集金日と検索項目のタイトル
G2セルには>=4/1、H2セルには<=4/30
抽出ボタンをクリックして一覧から取得しています。　
マクロは、説明が載っているHPからの独学なのでどう応用すれば良いのかがわかりません。
一覧に追加入力し、4月シートに4月分抽出。次に5月シートに5月分抽出とすると4月シートの抽出結果が消えてしまいます。

そこで、★で指定している4月シートではなく、現在選択している”シート”としたいのですが、どのように記述すればよいかわかりません。

自分が分からない事を、どう検索してよいかも分からなくなってきたので、どうかアドバイスお願いします。

No.1 ベストアンサー 回答者： Wendy02 回答日時： 2008/04/21 14:16

こんにちは。

AcName = ActiveSheet.Name
Worksheets(AcName).Range ....
とすればよいことですが、ちょっと良く分からないところがありますが、おそらくは、登録先の問題で、「標準モジュール」に入れないといけない、というところだと思います。


'標準モジュール

Sub DataCopyMacro()
Dim myRow1 As Long
Dim myRow2 As Long
Dim AcName As String
　　' 集金月で抽出
　　AcName = ActiveSheet.Name
　　
　　myRow1 = Worksheets("一覧").Range("B65536").End(xlUp).Row
　　myRow2 = Worksheets(AcName).Range("B65536").End(xlUp).Row
　　
　　If myRow2 >= 3 Then
　　　　Worksheets(AcName).Range("A3:P" & myRow2).ClearContents
　　End If
　　
　　Worksheets("一覧").Range("A3:P" & myRow1).AdvancedFilter _
　　Action:=xlFilterCopy, _
　　CriteriaRange:=Worksheets(AcName).Range("G1:H2"), _
　　CopyToRange:=Worksheets(AcName).Range("A4"), _
　　Unique:=False
End Sub

コントロールツールのコマンドボタンなら、このようになります。

Private Sub CommandButton1_Click()
　Call DataCopyMacro
End Sub

この回答へのお礼

出来ました！
Sheets(ActiveSheet)　とか、　Sheets("ActiveSheet")
とかで、エラーばかりでした。
>AcName = ActiveSheet.Name
略せるのですね！本当に助かりました。ありがとうございます。
ボタンですが、フォームのボタンに登録しています。
1年分のシート、12枚それぞれにボタンを置き、ボタン1個づつにマクロを登録していました。
コントロールツールのコマンドボタン、使ってみます♪
本当にありがとうございました。

お礼日時：2008/04/21 14:49