別のブックから今のシートに自動更新

質問

元データ（ブックAシート１）を更新するたび
条件にあったデータを
別ブックのシートに自動的に抽出したいのですが
ブックBを開いたらブックAが開きシート１の抽出をブックBシート１にコピーしたいのですがVBAコードを教えてください。

◇ブックAシート１◇ ※元データ
　A 　　　　 B 　　　 C 　　　 D 　　　 F
1　氏名　役職　部署　年齢　移動時期　　　　　
2　山田　社員　開発　45　　未調整
3　田中　社員　人事　42　　4/1～
4　鈴木　派遣　企画　30　　
5　高橋　役員　人事　50　　未調整
6　坂野　社員　企画　33　　未調整　　
7　井上　派遣　企画　29　　未調整

◇ブックBシート１◇　※部署が人事で移動時期が未調整の人のみ抽出
　A 　　　　 B 　　　　C 　　　 D 　　 F
1　氏名　役職　部署　年齢　移動時期　
2　高橋　役員　人事　50　　未調整

説明が不十分で伝わりにくいかと思いますが
よろしくお願いします。

回答No.1

imogasi · ベストアンサー

本件課題は、仕事で使う「ニオイ」がする。他の（他課の）人の作った・使う、データをまたがって使う複数人参加なのではないですか。
エクセルでは、他の人と共同で利用するのは、ＶＢＡでやるのは、相当知識と経験がが要り、この程度の質問の仕方をする人には、習得や慣れに今後長期を要するのではないかな。
他人利用でセキュリティや誤入力、誤操作に対する備えが、必要になり、非常にむつかしくやりにくいと思う。
エクセルは個人使用のソフトなのだと思う。それをエクセルしか知らない人が、何でもエクセルでややろうとする例が多いのではないか。
ーー
利用する仕組みとして、Ｏｆｆｉｃｅ関連に限ってでも、いろいろありそうだが、こういうことは何も質問に書いてない。
（１）抽出作業はどうするか
　　・Ｆｉｌｔｅｒ
　　・Ｑｕｅｒｙ
　　・その他
（２）他ブックへのコピー作業
　　・リンク
　　・Ｑｕｅｒｙ
（３）（１）の抽出作業・更新作業のキッカケ
　　　・リンク
　　　・Ｑｕｅｒｙ　Ｒｅｈｒｅｓｈ
　　　・ＶＢＡのイベント
ーー
自分だけでやるなら、
（Ａ）のブックを自分の領域にコピペしてきて
（Ａ）ブックの作業ＶＢＡ化はやるとしても、結果を（Ｂ）のブックのシートに手動コピペして、（Ｂ）のシートに
おいて作業（利用）すればよいと思う。普通はこの程度でしょう。
コピペが面倒とか、社内事情などで、質問のことが出てくるのかもしれないが、質問者のプログラム力がその近く
までいってなければ、諦めざるを得ないでしょう。丸投げして、このコーナーにお願いではね。
ーー
私は上記の仕組みのそれぞれを自由に使える力はないが、一応考えてみたので報告する。
仕組みは、Ｆｉｌｔｅｒ－コピーーイベントを使う。
下記の回答の場合、追試をやってみるなら
（Ａ）「フィルダ例１」という名のブック
（Ｂ　「フィルタ結果受け」という名のブック
をそれぞれ作る。
（Ａ）ブックには「Ｓｈｅｅｔ１」というシートを作り、この回答内の下記データをコピーし
質問者のエクセルシートに貼り付けする。
1 氏名 役職 部署 年齢 移動時期
2 山田 社員 開発 45 未調整
3 田中 社員 人事 42 4/1から
4 鈴木 派遣 企画 30
5 高橋 役員 人事 50 未調整
6 坂野 社員 企画 33
7 井上 派遣 企画 29
8 木下 社員 人事 50 未調整
9 坂野 社員 企画 33 未調整
10 奥村 派遣 企画 29 未調整
11 田島 社員 人事 50
12 大島 社員 人事 51 未調整

そして、データー区切り位置以下の操作で、質問者のエクセルシートSheet1の、各行の各列セルに分けられる。
これで私の作ったデータ例が質問者のエクセルシートに再現される
（Ａ）ブックには「Ｓｈｅｅｔ２」というシートを作っておく。
　　フィルタ後に結果を張り付けるシートです。
（Ｂ）には最小限で「Ｓｈｅｅｔ１」を作っておく。
＜準備＞
（Ａ）の「Ｓｈｅｅｔ１」（原データのシート）をＡｃｔｉｖｅにしておく。
　両方のブックを同時に開いておくこと。
＜コード＞
（Ａ）ブックの標準モジュールに回答の下記コードをコピペする。
Sub test01()
Windows("フィルタ例１.xlsm").Activate 'フィルタ例１の１は全角
Worksheets("Sheet1").Activate
With ThisWorkbook.Sheets("Sheet1").Range("A1").CurrentRegion
.AutoFilter
MsgBox "フィルタ解除を確認する"
.AutoFilter Field:=4, Criteria1:="人事"
.AutoFilter Field:=6, Criteria1:="未調整"
lastrow = ActiveSheet.Range("A1000").End(xlUp).Row
MsgBox lastrow
ActiveSheet.Range("A1:F" & lastrow).Copy Worksheets("Sheet2").Range("A1")
'ActiveSheet.Range("A1:F" & lastrow).Copy Workbooks("C:\Users\惇\Documents\フィルタ結果受").Worksheets("Sheet1").Range("A1")
Worksheets("Sheet2").Range("A1:F" & lastrow).Copy
Windows("フィルタ結果受.xlsm").Activate
Worksheets("Sheet1").Activate 'Sheet2にすればSheet2に張り付く
ActiveWindow.ActiveSheet.Paste
End With
End Sub

（Ｂ）ブックの標準モジュールに回答のコードをコピペする。
Sub test01()
'Application.Run "C:\Users\ｘｘｘ\Documents\フィルタ例１!test01"
Application.Run "フィルタ例１!test01"
End Sub

＜コード修正＞
フォルダ名（ブックの）はテストの場合も質問者の場合に合わせて変えること。
ブック名、シート名も本番では、質問者の場合に合わせて変えること。
＜実行＞
（Ａ）ブックのを実行してみて、（Ｂ）ブックの「Ｓｈｅｅｔ１］に、抜き出し結果が正しく
移るかテスト。
＜結果＞
Sheet2に
1 氏名 役職 部署 年齢 移動時期
5 高橋 役員 人事 50 未調整
8 木下 社員 人事 50 未調整
12 大島 社員 人事 51 未調整

＜テスト＞
うまく行けば、（Ｂ）ブックの標準モジュールの「Test01()」を実行して、（Ｂ）ブックの
「Ｓｈｅｅｔ１］に、フィルタ結果（抜き出し結果）が,
正しく移るかテスト。
結果は上記と同じく
1 氏名 役職 部署 年齢 移動時期
5 高橋 役員 人事 50 未調整
8 木下 社員 人事 50 未調整
12 大島 社員 人事 51 未調整
＜プロジェクトエクスプローラーの状態＞念のため記す
VBAProject(フィルタ結果受け.xlsm）
Module1 <ーー最終こちらを実行（C）
・・・
VBAProject(フィルタ例１.xlsm）
Module1　＜－－中間でテストで、こちらを実行確認
・・・
（C)は　Auto.Openイベント（開くと実行する）ででも実行するか、ボタンに登録する。
ーー
このやり方なら、その都度、本件操作時点の更新後の正しいデータを使うので、質問者側で更新に
気を使う必要はないだろう。