エクセルで複数シートから、検索して抽出

質問

はじめまして、右も左も分からない初心者です。

説明出来ないんですが、よろしくお願いします。

【ご質問内容】
エクセルは、XPを使用しています。

エクセルのVBAで、指定したキーワードを
含むデータを抽出したいと思っています。

【例】
Sheet1
A B C D E
1 番号　氏名　　郵便番号　　住所　　メールアドレス
2　1　　　○　　　△　　　　大阪府　　　○○
3　2　　　△　　　○　　　　茨城県　　　○○

Sheet2
　A　　B　　　　C　　　　　D　　　　　　E
1 氏名　番号　郵便番号　　住所　　メールアドレス
2　○　　１　　　△　　　　福岡県　　　○○
3　△　　３　　　○　　　　茨城県　　　○○

と各シートに、列がそれぞれバラバラになっています。

茨城県を検索すると、新しいシートに、

Sheet3
　A　　B　　　　C　　　　　D　　　　　　E
1 氏名　番号　郵便番号　　住所　　メールアドレス
2　2　　　△　　　○　　　　茨城県　　　○○
3 　A　　B　　　　C　　　　　D　　　　　　E
4 氏名　番号　郵便番号　　住所　　メールアドレス
5　△　　３　　　○　　　　茨城県　　　○○

という風に、抽出したいと思っています。

どうしたらいいでしょうか？？

よろしくお願いします。

回答No.2

pacific231

「右も左もわからない」と書いてあったのでわかりきった方法をお話ししてしまいました。

Sheet3以降は
cells.clear
以降の処理をそれぞれのシートでくりかえせばいいのではないでしょうか？
たくさんのシートがあるなら
For Each ws In ActiveWorkbook.Worksheets
などで取得できます。

また、貼り付け先の一番下のセルは
Range("A3").CurrentRegion.Rows.Count
などで使用領域の一番下の行数を取得できるはずです。
Destinationの行数をそれで指定すれば2シート目以降は使用領域の下に貼り付けられるはずです。

結構VBAもお使いになれるようですが、もっと難しいことで悩まれているのでしょうか？

お礼

pacific231様

ご回答ありがとうございます。

あれから、ずっと悩んで、やっと解決しました。

また、何かあれば、よろしくお願いします。

回答No.1

pacific231

回答がつかないようでコメントさせていただきます。

抽出結果を新しいシートに…とあるようですが、VBAを書くのが面倒なので（もちろんVBAでもできますよ）、単純に並べ替えとオートフィルターを使って手作業をしてみてはいかがでしょうか？

上に書かれている例を元に述べさせていただきます。

手順１
Sheet1のA列を切り取り、氏名と郵便番号の間に挿入

これでSheet1がSheet3と同じ並びになります。

手順２
Sheet1の1行目を選択しデータ - フィルタ - オートフィルタを実行
住所列のプルダウンを茨城で選択
抽出結果を選択→コピー、シート3に貼り付け

同様にSheet2も繰り返す

時間的にはおっしゃっていただいている例なら2～3分の作業で済むと思います。

もっと複雑な構造をしているのならば補足してください。

補足

回答、ありがとうございます。

オートフィルタなど、作業出来ますが、毎回同じ繰り返しだと、
面倒なので、VBAの方を作成して、簡単にしたいと思っています。

【補足説明】長文になりますので、スミマセン…

Sheet1
　　a　　　b　　　c　　　　　d　　　　　　　　e
1　番号　氏名　郵便番号　　住所　　　　　メールアドレス　
2　１　　太郎　　○○　　愛媛県　　　　　　　○○
3　２　　三郎　　△△　　愛知県名古屋市　　　▽▽
4　３　　一郎　　□□　　熊本県　　　　　　　□□
5　４　　次郎　　▽▽　　愛知県名古屋市　　　▽▽

検索ボタンをクリックする。

「検索したい住所の一部を入力してください」というユーザーフォーム（？）が現れる。

入力欄に、「名古屋」（取り出したい住所）と入力して、【OK】ボタンをクリックする

指定した文字列を含む住所のデータを抽出し、Shttt2に、コピーされる。

上記の方法では、以下のVBAが出来ます。

***************************************************
Sub ParamOutputData()

Dim strKeyword As String
Dim strJouken As String

strKeyword = InputBox("検索したい住所の一部を入力してください。")
Do While strKeyword = ""
strKeyword = InputBox("値が入力されていません。" & vbCrLf & _
"検索したい住所の一部を入力してください。")
Loop
strJouken = "*" & strKeyword & "*"

Application.ScreenUpdating = False
Sheets("Sheet2").Activate
Cells.Clear

With Sheets("Sheet1")
.Range("A3").AutoFilter Field:=4, _
Criteria1:=strJouken

.Range("A3").CurrentRegion.Copy _
Destination:=Sheets("Sheet2").Range("A3")

.Range("A3").AutoFilter
End With

Sheets("Sheet2").Columns("A:F").AutoFit
Application.ScreenUpdating = True

End Sub
******************************************************

これと同じように、複数のシート内にあるデータを、取り出して、
「検索結果（シート）」にコピーしたいと思っています。

よろしくお願いします。