VBA・オートフィルタで抽出・貼り付けをFor～Nextで実現するには？

VBA・オートフィルタで抽出をFor～Nextで実現するには？

お忙しいところお世話になります。
表題のとおり、VBAを使い、オートフィルタで抽出→貼り付け処理→移動を行いたく構文を考えています。

が、、どうもうまくできず、困っています。

自分で現状考えたコードは以下のとおりです。
--------------------------------------------------------------
Sub 貼り付ける()

For i = 1 To 3

Worksheets("集計表").Cells(2.1).AutoFilter Field:=1, Criteria1:=i
Range("A1").CurrentRegion.Copy Destination:=Worksheets(i).Range("A1")

Worksheets(i).Move

Next

End Sub
--------------------------------------------------------------

オートフィルタで選択する箇所は、管理番号というものがふられており、それが処理回数と一致しています。なのでオートフィルの部分を
Criterial=iとしてみたのですが、ここが違うのでしょうか・・・。

管理番号数＝処理数なので、１→２→３と順に処理をさせていきたいのです。

オートフィルタ後のの貼り付け処理は、とりあえず上記処理を行う前に貼り付けようの空シートが出来ているのでWorksheets(i)としてみましたが考えはあっているでしょうか。
（シート名＝管理番号で、新シートを作成する部分までは、以前作成したので出来ています）

類似の質問も見受けられますが、そこから自分のものを手直しするまで噛み砕く能力が低く、後学のためにも自分で考えたものにアドバイスいただけたらと思いこちらで質問させていただきます。

ご迷惑かけますがアドバイス頂けますと幸いです。
何卒宜しくお願い致します。

No.3 回答者： imogasi 回答日時： 2008/07/02 22:36

質問の意味を捉えてないかも知れない。

下記を実行してみて
Sheet2に
管理番号内容
1a
3b
2c
4d
3e
1f
2g
2h
3i
1j
5k
とテストデータを作った。
Sheet3・・Sheet7の繰り返し回数の５シートを用意した。
ーー
コード
Sub test01()
For i = 1 To 5
Worksheets("Sheet2").Activate
ActiveSheet.Range("A1:B1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=Str(i)
d = Worksheets("Sheet" & i + 2).Range("A65536").End(xlUp).Row
Worksheets("Sheet2").Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select
Selection.Copy _
Worksheets("Sheet" & i + 2).Range("A" & d + 1)
Selection.AutoFilter
Next i
End Sub
ーーー
結果
Sheet3、Sheet4,・・Sheet7の５シートに
Sheet3
管理番号内容
1a
1f
1j
Sheet4
管理番号内容
2c
2g
2h
・・・
と分散した。
こういうものが希望かな。

この回答への補足

imogasi様
おはようございます。昨日はご回答どうもありがとうございました。
説明が足らず色々と推測頂いてしまいお手数かけました・・・。
おっしゃるとおりの結果がイメージしているものです。

手元のテストデータ上、おかげさまでうまくいきました。
ありがとうございます・・・！
今日会社でも同様の趣旨でためしてみようと思っています。
（回答はその後締め切ります）
うまくいきそうな予感がします。

補足日時：2008/07/03 07:26

この回答へのお礼

随分日があいてしまいましたが、上記回答どうもありがとうございました。また遅くなり大変大変失礼致しました。おかげさまでフィルタごとで抽出の部分はうまく動くことが出来ました。

一応後学のために教えていただけると幸いなのですが、
下記の理解は正しいでしょうか？

・VBAのオートフィルタはA1にあることが前提で、そうでない場合は
コードを書き換えてもうまくいかない
（会社での表はA7からAL7まででフィルタがかけてあるのですが、
ActiveSheet.Range("A1:B1").Selectのところを、A7:AL7にしても
うまくかからず、もしかして、そういうものなのかなと思いました。
色々調べたのですが明確な回答が見つからず、ご存知だったら教えていただけないでしょうか。）

・（本質問の場合）フィルタをかけた部分のコピーは可視セルだけ値を貼り付けで行っている。このような場合、抽出対象となった表以外のセルはコピーできない
（実は、実際は使っている表の下に表とは別で
各種データや数式が入っているところがあり、関数のSUBTOTALでフィルタに応じた値を出し、その値をそのまま値貼り付けも出きればと思っていたのですが、どうもそのSUBTOTALの別表はコピー時に認識されず、貼り付けが出来きませんでした。）

お礼欄としてはふさわしくなく、かつ大変失礼なお願いなのですが
ご存知でしたら教えて頂けると幸いです。

お礼日時：2008/07/23 10:35

No.2 回答者： Masa2072 回答日時： 2008/07/02 17:08

コピー元シートが左から3番目以内に存在していて、自分自身を処理しようとしていませんか？

（集計表シートがシート左下のシートタブの左３つ以内に存在すると処理対象を自分自身を含めてしまいます。）
またコピー元シートを誤って修正しないようにシート保護をかけていませんか？

おそらく上記2点が原因の複合的エラーだと思います。

For i = 1 to 3
の下で
If Sheets(i).Name = "集計表" Then
などで自分自身を処理対象から外すロジックを追加したほうがよいでしょう。

No.1 回答者： Masa2072 回答日時： 2008/07/02 12:36

Sub 貼り付ける()

For i = 1 To 3
'複数のブック、シートを扱う際は必ずオブジェクトを指定するようにします
ThisWorkbook.Worksheets("集計表").Cells(2.1).AutoFilter Field:=1, Criteria1:=i
'MOVEを行うとシートが減るためインデックス番号が変わります
'コピー先シートのインデックス番号は常に1です。
ThisWorkbook.Worksheets("集計表").Range("A1").CurrentRegion.Copy Destination:=Worksheets(1).Range("A1")
'ここも上同様、シートインデックス番号は常に１になります。
Worksheets(i).Move

Next

End Sub

この回答への補足

早速のご回答ありがとうございます。
先ほどに引き続き、何度もアドバイス頂きお手数かけてしまい恐縮です。

なぜか、
ThisWorkbook.Worksheets("集計表").Range("A1").CurrentRegion.Copy Destination:=Worksheets(1).Range("A1")

のところでエラーが出てしまいます。実行エラー1004とのこと・・・
何か注意すべきことはありますでしょうか・・

補足日時：2008/07/02 13:05