[[20160107102118]]　『フィルターをかけて抽出を繰り返したいのですが…』（数余）　ページの最後に飛ぶ

『フィルターをかけて抽出を繰り返したいのですが…』（数余）

初めて利用させていだたきました。
色々と自分でも調べてみたのですが、VBA初心者の私では理解できない部分も多々あり、
やりたいことができずにおりましたので、是非アドバイスなどいただければと思います。

　　A　 B 　 C 　　D…K
1　No. Title 号　店舗
2　１　Ａ
3　２　Ｂ
4　３　Ｃ
5　４　Ｄ
6　１　Ａ
7　３　Ｃ

上記のようなエクセルデータを作成しております。
データの内容としては、受入があった本を順次追加しているものです。
現在約300ほどのデータがあります。

Bにあるタイトルは実際は60ほどあって、手作業でフィルターをかけなおしてコピペしていると
時間がかかってしまうので、そのあたりをマクロでなんとかして、
A～Kを別の指定のシートに貼り付けたいのですが、
そのタイトルの指定をどのようにすればいいのかがわかりませんでした…。

過去ログも拝見し、色々と試作してみましたが、
エラーが起こったり、やりたいこととは別の結果が起こったので、
投稿させていただいた次第です。

どうか、ご指導のほどよろしくお願いいたします。

ちなみにこのデータがあるシートは「受入状況」という名前になっていて、
貼り付けたいシートは「受入確認」となっております。「受入確認」で計算をしてから、
また別シートに貼り付ける作業がありますが、
そちらは既に別のマクロを完成させているので、
できればあとからそのマクロと合体させられたらと思っています。
なので、私自身きちんとマクロを理解しなければならないのですが…
いかんせん学が足りないようで、理解が追いつきませんでした…

つたない文章で失礼いたします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

 連続して　受入確認シートに抽出したものを、どのようにするのかが見えませんが、とりあえず、
 タイトルごとに抽出実行するサンプルです。
 フィルター詳細設定（フィルターオプション）機能を使っています。

 Sub とりあえず()
    Dim shF As Worksheet
    Dim shT As Worksheet

    Set shF = Sheets("受入状況")
    Set shT = Sheets("受入確認")

    shT.Columns("A:K").ClearContents
    shT.Range("A1:K1").Value = shF.Range("A1:K1").Value 'タイトル行

    shF.Columns("B").Copy shF.Range("M1")                       '抽出タイトル作業列
    shF.Columns("M").RemoveDuplicates Columns:=1, Header:=xlYes 'タイトル一意化のため重複削除

    '抽出ループ処理
    Do While Not IsEmpty(shF.Range("M2"))   '抽出タイトル
        shF.Range("M2").Value = "'=" & shF.Range("M2").Value    '念のため完全一致対応
        'フィルターオプションによる抽出
        shF.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=shF.Range("M1:M2"), CopyToRange:=shT.Range("A1:K1"), Unique:=False

        'テスト確認コード（実際には、抽出されたものに対して何か行うコードをがこの部位に）
        shT.Activate
        MsgBox "抽出結果を確認してください"
        'テスト確認コード終わり

        shF.Range("M2").Delete xlUp
    Loop

    shF.Range("M1").Clear

 End Sub

（β） 2016/01/07(木) 11:10

β様
早速のご回答ありがとうございます。
抽出したものは、タイトルごとに契約冊数が決まっていますので、
ちゃんと契約冊数分が届いているか、「受入確認」で価格などを確認して、
上司に提出するためのシート（仮にシート名を「事務室長」としておきます）に
それぞれ確認したものを貼り付けていく予定です。

β様よりいただきましたものをコピペし、
間に「事務室長」へのコピペなどのマクロを挿入したところ、
やりたいことができました！
本当にありがとうございます…！
これまで過去ログなどを参照してもできなかったので、
本当に嬉しいです…！
こんなにあっさり解決していただけるとは、流石です…！

まだ罫線のコピーに関して、うまくいかなかったところがありましたので、
少しずつ調整していきながら期末に向けて頑張ろうと思います。
ありがとうございます！
（数余） 2016/01/07(木) 11:41

β様
罫線の件はすぐに解決いたしました！
どこまで伏せて、どこまで開示してご説明すればよいか、判断に悩みつつの相談でしたので、
説明不足も多々ある中、意図を汲み取っていただき、的確なものを教えていただき、
本当にありがとうございました！
（数余） 2016/01/07(木) 11:46

コメント返信：

[ 一覧(最新更新順) ]

[[20160107102118]] 『フィルターをかけて抽出を繰り返したいのですが…』（数余） ページの最後に飛ぶ

[[20160107102118]]　『フィルターをかけて抽出を繰り返したいのですが…』（数余）　ページの最後に飛ぶ