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

質問の意味を捉えてないかも知れない。
下記を実行してみて
Sheet2に
管理番号 内容
1 a
3 b
2 c
4 d
3 e
1 f
2 g
2 h
3 i
1 j
5 k
とテストデータを作った。
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
管理番号 内容
1 a
1 f
1 j
Sheet4
管理番号 内容
2 c
2 g
2 h
・・・
と分散した。
こういうものが希望かな。

お礼

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

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

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

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

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

補足

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

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

回答No.2

Masa2072

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

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

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

回答No.1

Masa2072

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とのこと・・・
何か注意すべきことはありますでしょうか・・