VBA で抽出したデータが一定数まできたら、異なるセルに折り返して抽出するように設定したい。

質問

VBA で抽出したデータが一定数まできたら、異なるセルに折り返して抽出するように設定したいです。

◇シート１◇ ※元データ
　A 　　　　 B 　　　 C 　　　 D 　　　
1|　氏名　役職　部署　年齢　　　　　
――――――――――――――――
2|　山田　社員　開発　45　
3|　田中　社員　人事　42　　
4|　鈴木　派遣　企画　30　　
5|　高橋　役員　人事　50
6|　坂野　社員　企画　33　　
7|　井上　派遣　企画　29

◇シート２◇　
条件1.役職は"役員"で、部署が"人事"の人の
　 氏名、役職、部署をA3から順に抽出する

条件2.A列のデータが9行目まできたら
　　　　D3に抽出されるようにする

　A 　　　　 B 　　　　C 　　　 D 　　　 E 　　　F
1　氏名　役職　部署　　氏名　役職　部署
2　高橋　役員　人事　　
3
4
5
6
7
8
9
――――――――――――――――――――

ちなみにこのサイトで以下のコードを作成してもらいましたが
これだとデータ元の全ての行が抽出されてしまいます。

Private Sub Worksheet_Activate()
With Sheets("Sheet1")
.AutoFilterMode = False
.Range("A1:E1").AutoFilter
.Range("A1:E1").AutoFilter Field:=2, Criteria1:="役員"
.Range("A1:E1").AutoFilter Field:=3, Criteria1:="人事"
.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)).SpecialCells(xlCellTypeVisible).Copy Range("A3")
.AutoFilterMode = False
End With
End Sub

条件2のデータを折り返す条件が難しいようであれば
条件1の3列のみ抽出する方法で結構ですので教えてください。
よろしくお願いします。

回答No.4

merlionXX · ベストアンサー

おはようございます、merlionXXです。

> 抽出数が記載されたポップアップ（エラー表示のような小さいウィンドウ）が表示されるのですが

それは失礼しました。
テストで確認用にわたしが余分なものをつけて、そのまま消し忘れていました。
わたしのコードの下から6行目の
MsgBox lstRow2　
という一行を削除してください。

お礼

こんばんわ。
メッセージウィンドウ、表示されなくなりました^^
ちょっと調べればわかりそうな事でしたね。。
勉強します！
どうもありがとうございました！

回答No.3

merlionXX

おやまたお会いしましたね。

> 条件2.A列のデータが9行目まできたら

A列は3行目から始まるんですよね？
なら9行目とはA10セルまでという意味でいいのかな？

Private Sub Worksheet_Activate()
With Sheets("Sheet1")
.AutoFilterMode = False
lstRow = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:C1").AutoFilter
.Range("A1:C1").AutoFilter Field:=2, Criteria1:="役員"
.Range("A1:C1").AutoFilter Field:=3, Criteria1:="人事"
.Range(.Range("A1"), .Range("C" & lstRow)).SpecialCells(xlCellTypeVisible).Copy Range("A3")
.AutoFilterMode = False
End With
lstRow2 = Range("A" & Rows.Count).End(xlUp).Row
MsgBox lstRow2
If lstRow2 >= 12 Then
Range("D3:F3").Value = Range("A3:C3").Value
Range("A12:C" & lstRow).Cut Range("D4")
End If
End Sub

お礼

merlionXXさん、こんばんは。

前回に引き続き、またご回答くださり、ありがとうございます。
さっそく使用させていただきました。
完全にマッチしてくれて、感動しました！

何度も申し訳ないのですが
１点質問です。

データが抽出されたとき
抽出数が記載されたポップアップ（エラー表示のような小さいウィンドウ）が表示されるのですが
これを表示させなくすることはできますか？

OKボタンを押せば消え、ファイルも問題なく使用できるので
もしお時間があるときに
教えていただけると幸いです。

よろしくお願いします。

回答No.2

n-jun

＞条件1の3列のみ抽出する方法

Private Sub Worksheet_Activate()
With Sheets("Sheet1")
.AutoFilterMode = False
.Range("A1:E1").AutoFilter
.Range("A1:E1").AutoFilter Field:=2, Criteria1:="役員"
.Range("A1:E1").AutoFilter Field:=3, Criteria1:="人事"
Intersect(.Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell)) _
.SpecialCells(xlCellTypeVisible), .Range("A:C")).Copy Range("A3")
.AutoFilterMode = False
End With
End Sub

一例まで。

お礼

ご回答ありがとうござます！

さっそく使用させていただきました。
助かりました！！
他のファイルでも活用できそうです＾＾

急ぎで回答くださったのに
お礼が遅れて申し訳ございません。
ありがとうございました。

回答No.1

FEX2053

なんか複雑なことを考えておられるようですが、要するにそのマクロを
使って一旦「シート３」に全項目の該当するレコードを引っ張り出し、
「シート２」は「シート３」の所要の項目を式で参照すれば済む話では
ないんでしょうか？

マクロに慣れると全部をマクロでやりたくなりますが、せっかくExcel
には「関数」という便利なものがあるんですから、使わない手はないかと。

お礼

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

マクロの便利さに感動し、何でもできそうと思いましたが
確かに関数の方が向いているかもしれませんね。
複雑にすると
自分も他のファイル使用者も使いづらくなってしまいますよね。。

関数でもいろいろためしてみます！

急ぎで回答下さったのに、お礼が遅れてしまい、すみませんでした。
ありがとうございました。