検索マクロ

質問

こんばんわ。

エクセル初心者です。

今、下記の画像（中、下）のとおり、エクセルのシート２（1月分情報）からデータを
入力しています。シートは10枚くらいになる予定です。

データの構成は、各シートのA2から氏名が入力されており、何名入力されているかは
各月シートによって違っています。

列数はA列からF列まで6列文にそれぞれ情報が入力されています。

今ここでしたい処理なのですが、下画像の上段のようにシート1に氏名検索用の
シートを作り、氏名の一文字を入れることによって、シート２以降にあるすべての氏名情報を引っ張ってシート1に表示したいのです。

何かいいコードはあるのでしょうか。今は目視で各シートをひとつづつ確認しているので
大変です。

よろしくお願いします。

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.2

tom04 · ベストアンサー

こんばんは！
一例です。

標準モジュールの↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub 抽出() 'この行から
Dim i As Long, k As Long
Application.ScreenUpdating = False
Range("E:J").ClearContents
With Range("E1")
.Value = "氏名"
.Offset(, 1) = "勤務店"
.Offset(, 2) = "職種"
.Offset(, 3) = "採用日付"
.Offset(, 4) = "年齢"
.Offset(, 5) = "性別"
End With

If Range("A4") = "" Then
MsgBox "検索データを入力してください。"
Range("A4").Select
Exit Sub
End If
For k = 2 To Worksheets.Count
Worksheets(k).Cells(1, 1).CurrentRegion.AutoFilter field:=1, Criteria1:="*" & Range("A4") & "*"
i = Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
Range(Worksheets(k).Cells(2, 1), Worksheets(k).Cells(i, 6)).Copy _
Cells(Rows.Count, 5).End(xlUp).Offset(1)
Worksheets(k).AutoFilterMode = False
End If
Next k
Application.ScreenUpdating = True
End Sub 'この行まで

※　画像を拝見するとコマンドボタンが配置してあるようですが、
もしコマンドボタンをクリックしてマクロを実行する場合は、標準モジュールはそのままで

Private Sub CommandButton1_Click()
Call 抽出
End Sub

をコマンドボタンのコードにしてみてください。m(_ _)m

お礼

みなさま、ありがとうございました。

完ぺきにできました。

回答No.1

keithin

一番簡単なマクロ。

private sub commandbutton1_click()
　dim s as string
　dim w as long
　dim r as long

　s = worksheets("Sheet1").range("A4").value & "*"
　worksheets("Sheet1").range("E:J").clearcontents
　if s = "*" then exit sub

　for w = 2 to worksheets.count
　for r = 2 to 9999
　　if worksheets(w).cells(r, "A") = "" then exit for
　　if worksheets(w).cells(r, "A") like s then
　　　worksheets(w).cells(r, "A").resize(1, 6).copy _
　　　　destination:=worksheets("Sheet1").range("E65536").end(xlup).offset(1)
　　end if
　next r
　next w
end sub