マクロを使って、抽出したデータを別のファイルにコピーしたい

質問

VBA初心者です。
自動記録で、フィルターオプション設定を使い抽出したデータを、別ファイルにまとめようとしています。

自動記録ですので、実行はできるのですが、このままだとデータの更新があった時、
範囲の指定をやり直すことになりますので、少しシンプルで応用の効くコードにしたいと思っています。

集約するシート：テスト用 sheet1(集約）　sheet2（条件）
元のデータ：金額一覧表(01～03)　金額一覧表(04～06)　金額一覧表(07～10)
sheet1=ファイル名　＜各データは２万～３万件＞

Sub 抽出_1()

Windows("金額一覧表(01～03).xls").Activate
Range("A1:R16824").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Workbooks("テスト用.xls").Sheets("条件").Range("A1:F27"), Unique:=False
End Sub
------------------------------------------------
Sub データを転記_1()

Windows("金額一覧表(01～03).xls").Activate

Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("テスト用.xls").Activate
Sheets("集約").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
---------------------------------------------------
　又、金額一覧表(01～03)のデータを貼り付けた後、
金額一覧表(04～06)も同じようにデータ抽出コピーしようとしたのですが、
Sub データを転記_()
の６行目に下記のようなコードを入れたところ、
７行目がデバックしてしまいました。
（実行時エラ-：1004 　
コピー領域と貼り付け領域の形がちがうため情報を貼り付けることができません）
とエラーが出てしまいました。

6行目　　Set sakiRng = Range("A65536").End(xlUp).Offset(1)
7行目　　ActiveSheet.Paste　　←ここがデバック

何か指定し忘れているものがあるのでしょうか？
お知恵拝借できれば幸いです。

回答No.2

Wendy02 · ベストアンサー

こんばんは。

>Range("A1").Select　　←ここの部分を
>ActiveSheet.Paste

Range("A65536").End(xlUp).Offset(1).Select

のように変えればよいです。

>　A106:R211 ←　金額一覧表(04～06)〃
こういうように、貼り付け範囲を指定すると、コピーした範囲と大きさが違うのでエラーが出ますから、左上端を設定させればよいです。後は、範囲を自動的に指定してくれます。

>Range("A1:R16824").AdvancedFilter

こういう場合、地続きになっていれば、Range("A1").AdvancedFilter だけでよいです。

その範囲を他に転用する場合は、

With Range("A1").CurrentRegion
　　.AdvancedFilter
　　' ここに、With ステートメントの範囲を省略して書けます。
End With

とします。

明示的に取りたい場合は、
>Range("A1:R16824").AdvancedFilter

Range("A1",Range("R65536").End(xlUp)).AdvancedFilter

となります。つまり、Rの右、S,T,.. 列にデータがある場合ですね。

お礼

返事が遅くなってすみません。
何回も教えて頂いて、恐縮です。
おかげさまで、なんとかうまくいきました！
ありがとうございました。

補足

こんにちは。
丁寧な説明、ありがとうございます。
抽出の部分は、ご提示頂いたコードで上手くいきました。

ただ、コピーの時に、タイトル行まで貼り付けてしまいました。

Sub データを転記_1()

Windows("金額一覧表(01～03).xls").Activate
Sheets("金額一覧表(01～03)").Select

Application.CutCopyMode = False

Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("テスト用.xls").Activate
Sheets("集約").Select
Range("A65536").End(xlUp).Offset(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Selection.SpecialCells(xlCellTypeVisible).Select
↑
　この辺りでコピー元を指定しているのだと思いますが…
Range("A2",Range("R65536").End(xlUp)
と入てみたのですが、「コンバイルエラー」
と出てしまいました。

すみません。自分ではどこにどのような指定すればよいのか、
よくわからないので、教えて頂ければ大変助かります。
よろしくお願いします。

回答No.3

Wendy02

こんばんは。

もしかして、こう書きませんでしたか？
　Range("A2", Range("R65536").End(xlUp).SpecialCells(xlCellTypeVisible).Select

　それは、
　 Range("A2", Range("R65536").End(xlUp)).SpecialCells(xlCellTypeVisible).Select

と書いてください。End(xlUp)　の後の「)」が抜けていますが、これは私も良くやるミスです。他は今は分かりません。

なお、これとは直接関係ない話ですが、私は、
VBE のツール－オプション－編集
の自動構文チェックは、オフにしています。

間違いは間違いで赤い字になるので、「コンパイルエラー」のメッセージボックスの立ち上がりはうるさいのです。

お礼

遅くなってすみません。
投稿したつもりが、送信されていませんでした。
なんとか上手くいきました。ありがとうございます！！

回答No.1

Wendy02

こんばんは。

Selection.SpecialCells(xlCellTypeVisible).Select　
'~~~~~~~~~
Selection.Copy

Selection そのものが、コードを見る限りは、読み取れませんね。
それと、SpecialCellsで、可視セルをコピーしても、貼り付けは利きませんね。

こんな風にして、

Range("A1:R16824").Copy
Windows("テスト用.xls").Activate
Sheets("集約").Select
Range("A1").Select
ActiveSheet.Paste

通常はこのような書き方はしませんが、元のコードを使ってみました。
SpecialCells を使わなくても出来るはずです。ただし、バージョンなのか、何が原因かは分かりませんが、間の部分も全部コピーする、というトラブルを受けたことがあります。うまくいくか試してみてください。

補足

ご回答ありがとうございます。
え～っと、説明が悪くてすみません。
金額一覧表(01～03)のSheets("集約")への貼り付けはできています。
その後、金額一覧表(04～06)で抽出したデータを、
先に貼り付けたデータの最後行の次へコピーしたいのですが、
コードの入れ方や挿入場所がわからなのです。

Sheets("集約")　A2:R105 ←金額一覧表(01～03)の抽出データ
　　　　　　　　A106:R211 ←　金額一覧表(04～06)〃
　　　　　　　　A212:R355 ←　金額一覧表(07～10)〃
　　　　　　　　↑　コピー位置を自動取得したい

それから、最初のフィルターをかける範囲ですが、
Range("A1:R16824").AdvancedFilter
　　　　　　　↑
データの入っている最後のセルを自動的に取得したいのです。
Range("A1:("R65536").End(xlUp).Row）
のような書き方で良いのでしょうか？

お手数かけますが、よろしくお願い致します。