[[20160527113353]]　『【VBA】選択した項目の列をすべて別シートに抽出＝x（うみ）　ページの最後に飛ぶ

『【VBA】選択した項目の列をすべて別シートに抽出→ブック内の複数シートに適用したい』（うみ）

 下記は、選択した項目名に該当する列をすべて抽出して別シートにするコードだそうで、他のサイトで恐縮ですが、
pi-chanさんとおっしゃる方がご紹介されていたものです。
これを応用する形で、ブック内の複数のシートについて行いたい（コピー元シートがn個、コピー先シートがn個）
のですが、どのように変更すればよいでしょうか？
大変困っています、どうかご教示ください。

( 以下、コード削除しました。)

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

 コードを眺めたレベルですが、本件は、現在の処理方式よりフィルターオプションが適しているように思えます。
 またシートがなかった場合の対処としてOn Error GoTo/Resume Next を使っておられますね。
 これでもいいのですが、GoTo を使わず 普通の制御にされたほうがいいと思います。

 が、それはさておき。

 コードを詳細に追いかければ、処理に関連するブックは何と何なのか、
 関連シートのレイアウトがどうなっているのか、把握はできるかと思いますが、
 手を抜かず、それらを具体的に説明願えませんか？

 で、その現在の状況に対して、具体的に、どうしたいのかを説明いただけませんか？
 複数のコピー元　といっても、それらは、どう判定するのかとか、複数のコピー先といっても、それらはどれなのかとか
 わからないことが少なくありません。

（β） 2016/05/27(金) 08:12

コメントありがとうございます。

上記のブックの詳細は、こちらのとおりです。画像の貼り付けがうまくできず、リンクで失礼します。
https://teratail.com/questions/17602

複数のコピー元、コピー先とは、上記リンクの「オリジナル」シートと、コピー結果が出力される「住所一覧」シートで、これらをそれぞれn個に増やしたいと思っています。

どうぞよろしくお願いいたします！
（うみ） 2016/05/27(金) 08:21

 列選択シートに記載する抽出列情報はあくまで１つですね？

 で、オリジナルと住所一覧もシート名ですけど、たとえば
 オリジナル1 というシート名に対して　住所一覧1 というシート名、
 オリジナル5 というシート名に対して　住所一覧5 というシート名、
 といった関連付けでいいですか？

 それと、コメントしたように、本件フィルターオプションがベストだと思いますので
 アップされたコードを無視してフィルターオプション処理コードにしてもいいですか？

 (アップされたコードではコピー先シート名がない場合に新規作成していますが、こちらがアップするコードでは
  エラーメッセージを出して、当該コピーをスキップする予定です）

（β） 2016/05/27(金) 09:10

列選択シートに記載する抽出列情報は、リンク先のように、「No.」、「氏名」、「住所」、「郵便番号」の4つの項目名で、すべてのオリジナル(コピー元)シートから、同じ項目名の列を抽出したいです。
このとき、A列、C列といった固定列ではなく、あくまでも項目名で識別させたいです。

シート名は、オリジナル1に対して住所一覧1といった関連で大丈夫です。

フィルターオプション処理コードでも構いません。

どうぞご教示の程宜しくお願い申し上げます！
（うみ） 2016/05/27(金) 09:27

「他のサイトを見て作成しました」と言って貼られたコードですが、詳細リンク先を見ると、pi-chanさん作のコードそのままではないですか。それとも、貴方がpi-chanさん？質問内容からすると、コーディングした当人には見えませんが、他人のコードを自分が作った、と偽ることは違法です。作ってもらった当人ならば、恩を仇で返していることになります。

「他のサイトでpi-chanさんに作って頂きました」または「他のサイトでpi-chanさんが書かれたコードです」というのが筋であり、それ以前に、元の掲示板で質問すべき。（teratailの方がメジャーですし）

言いたいことだけ言って、何も建設的な案を出さないのは本意ではありませんが、ちょっとカチンときました。
（???） 2016/05/27(金) 10:02

ご指摘ありがとうございます。誤解を招き、申し訳ありません。
質問文を訂正いたしました。

引き続きアドバイスお願いいたします。
（うみ） 2016/05/27(金) 10:50

 削除されていたので復元。回答が付いているのに勝手に削除するのはやめようよ。
（bi） 2016/05/27(金) 11:37

 確かに、別サイト（teratai）で、再質問されるほうが、自然ですし、スムーズにいくとは思いますが
 ここで質問者さんがアップされた文章には

 >>・・・にするコードだそうで
 >>他のサイトで恐縮ですが、pi-chanさんとおっしゃる方がご紹介されていたものです。

 と書いておられますね。ご自分で作ったものだとは言われていないと思いますね。

 もちろん、他人のコードを、そのままアップするのは、たとえ、参考情報だとしても、よろしくないことで
 URLでの参照がベストだったとは思いますが。

 いずれにしても、ご本人が削除されたようですので、私も撤収します。

（β） 2016/05/27(金) 11:49

 ↑　あぁ、質問文そのものを、正しい表現になおされたんですね？

（β） 2016/05/27(金) 11:54

 質問者が書き換える前の内容はこちら↓

 下記は、選択した項目名に該当する列をすべて抽出して別シートにするコードだそうで、他のサイトを見て作成し
 ました。
 これを、ブック内の複数のシートについて行いたい（コピー元シートがn個、コピー先シートがn個）のですが、どの
 ように変更すれば よいでしょうか？ 
（bi） 2016/05/27(金) 11:57

質問者のうみです。
最初に質問欄にコードを不適切な形で掲載してしまい、特に作成者のpi-chan様には大変失礼なことをして申し訳ありませんでした。
ご指摘のコメントを拝見し、質問文の変更とコードを削除しました。
β様には、ご相談に乗っていただいたにも関わらず、こうした事情で中断してしまい、申し訳ありませんでした。
ご指摘いただいた方にも、不快な思いをさせてしまい、申し訳ありませんでした。

（うみ） 2016/05/27(金) 14:09

 戻ってこられないかもしれませんが、最初の質問のやり方が不慣れで、ちょっと不適切だったということで。
 フィルターオプションでの処理案をアップしておきます。

 オリジナル○　から　住所一覧○　に転記します。　住所一覧○がなければ新規で作ります。
 なお、　オリジナル　や　住所一覧　という名前はコード先頭の Constで任意の名前にすることもできます。

 Sub Sample()
    Const FROMNM As String = "オリジナル"
    Const TONM As String = "住所一覧"
    Dim nameF As String
    Dim colnames As Variant
    Dim shF As Worksheet
    Dim shT As Worksheet

    Application.ScreenUpdating = False

    With Sheets("列選択")
        colnames = WorksheetFunction.Transpose(.Range("A5", .Range("A" & Rows.Count).End(xlUp)))
    End With

    For Each shF In Worksheets
        If shF.Name Like FROMNM & "*" Then
            nameF = TONM & Replace(shF.Name, FROMNM, "")
            Set shT = Nothing
            On Error Resume Next
            Set shT = Worksheets(nameF)
            On Error GoTo 0
            If shT Is Nothing Then
                Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = nameF
                Set shT = Worksheets(nameF)
            End If
            shT.UsedRange.ClearContents
            shT.Range("A1").Resize(, UBound(colnames)).Value = colnames
            shF.Range("A1").CurrentRegion.AdvancedFilter copytorange:=shT.Range("A1").CurrentRegion, Action:=xlFilterCopy
        End If
    Next

 End Sub

（β） 2016/05/27(金) 16:22

β様、

質問者のうみです。
ファイルの処理も自力でできず、質問にも不備があり、今日一日とても落ち込んでいましたが、
β様に教えていただいたコードでテストファイルの動作確認できました！

本当に、ありがとうございます。ご親切に救われました、心より感謝申し上げます。
（うみ） 2016/05/27(金) 21:04

コメント返信：

[ 一覧(最新更新順) ]

[[20160527113353]] 『【VBA】選択した項目の列をすべて別シートに抽出＝x（うみ） ページの最後に飛ぶ

[[20160527113353]]　『【VBA】選択した項目の列をすべて別シートに抽出＝x（うみ）　ページの最後に飛ぶ