【VBA】マクロ動作中にシートを移動して見えるようにしたい

前提

VBAで任意の日付に入社、異動または退職した社員リストをＣSV形式で出力するマクロを作っています。同じブック内で、シートは以下の3枚です。menuは下記のマクロを登録したボタンを配置するシートです。

1. 異動DB
2. 異動者リスト
3. menu

該当のソースコード

CSVに出力するSubは別のモジュール内にありますが、実現したいことに直接関係ない為、ここでは省略します。（※回答に必要であれば追記します。）

VBA

1Sub idou() 2'異動者リストを作成する 3 4 Dim d As Date 5 Dim dval As String 6 Dim flag1 As Boolean 7 Dim flag2 As Boolean 8 Dim i As Long 9 Dim cnt As Long 10 Dim LastRow As Long 11 Dim rg As String 12 Dim sec As String 13 14 Dim strDateFormat As String 15 Dim wS1 As Worksheet 16 Dim wS2 As Worksheet 17 18 Dim rc As VbMsgBoxResult 19 20 'ワークシートを変数で宣言する 21 Set wS1 = Worksheets("異動DB") 22 Set wS2 = Worksheets("異動者リスト") 23 24 flag1 = False 25 flag2 = False 26 strDateFormat = wS1.Range("B2").NumberFormatLocal 27 28 '任意の日の異動者を抽出する 29 Application.ScreenUpdating = False 30 31 '区分を選ぶ 32 Do While flag1 = False 33 dval = InputBox("数値を入力してください(1:入社、2:異動、3:退職)(※半角数字)") 34 If StrPtr(dval) = 0 Then 35 'キャンセル又は右上の×をクリックした場合 36 Exit Sub 37 ElseIf dval = "" Then 38 'なにも入力しないでOKをクリックした場合 39 MsgBox ("何も入力されていません") 40 41 ElseIf dval = "1" Or dval = "2" Or dval = "3" Then 42 '入力値が正しい場合 43 sec = dval 44 flag1 = True 45 Else 46 '入力値が正しくない場合 47 MsgBox ("入力し直してください") 48 End If 49 Loop 50 51 '年月日を入力する 52 Do While flag2 = False 53 dval = InputBox("基準日を入力してください(記入例：1900/1/1)") 54 If StrPtr(dval) = 0 Then 55 'キャンセル又は右上の×をクリックした場合 56 Exit Sub 57 ElseIf dval = "" Then 58 'なにも入力しないでOKをクリックした場合 59 MsgBox ("何も入力されていません") 60 61 ElseIf IsDate(dval) = False Then 62 '入力日付が正しくない場合 63 MsgBox ("あり得ない日付です") 64 65 Else 66 '入力日付が正しい場合 67 '（必要があれば入力日付のチェックを行い、エラーなら再入力する） 68 d = CDate(dval) 69 flag2 = True 70 End If 71 Loop 72 73 '異動者リストで3行目以降をクリアする 74 wS2.Rows("3:" & Rows.Count).ClearContents 75 76 'オートフィルタで区分データを抽出する 77 '（抽出する区分は1:入社、2:異動、3:退職） 78 wS1.Range("A1").AutoFilter Field:=1, Criteria1:=sec 79 80 'オートフィルタで入力した日付を抽出する 81 wS1.Range("A1").AutoFilter Field:=2, Criteria1:=Format(d, strDateFormat) 82 83 'オートフィルタ結果の行数をカウントする 84 rg = "D1:D" & wS1.Range("D1").CurrentRegion.Rows.Count 85 cnt = WorksheetFunction.Subtotal(103, wS1.Range(rg)) 86 87 '1行のみの場合（見出し行のみ）終了する 88 If cnt = 1 Then 89 MsgBox ("該当する社員が存在しません") 90 91 'オートフィルタを解除 92 wS1.Range("A1").AutoFilter 93 wS1.Range("B1").AutoFilter 94 95 Exit Sub 96 End If 97 98 '抽出した社員番号をコピーして貼り付ける 99 LastRow = wS1.Cells(Rows.Count, "D").End(xlUp).Row 100 wS1.Range("D1").CurrentRegion.Range("D1").Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") 101 102 '異動者リストにコピー貼り付け 103 Call Copy 104 105 '異動者リストをCSVで出力 106 rc = MsgBox("該当社員情報をCSVで出力しますか？", vbYesNo + vbQuestion) 107 If rc = vbYes Then 108 '「はい」をクリックした場合 109 Call Module6.CSV出力 110 111 Else 112 '「いいえ」をクリックした場合 113 Exit Sub 114 115 End If 116 117 Application.ScreenUpdating = True 118 119End Sub

実現したいこと

このマクロの動作中、画面は【menu】のままです。

• (103行目)【異動者リスト】に抽出結果を貼り付けた時
• (106行目)メッセージボックスを表示させる時

この間のタイミングで、【異動者リスト】に移動させたいです。
抽出結果が正しいかユーザーに確認してもらうのが目的です。

試したこと・発生している問題

シンプルに103行目と106行目の間にActivateを入れればいいだろう、と思い、入れてみたのですが、【異動DB】が真っ白なままで移動されませんでした。メッセージボックス自体は問題なく動作しました。

wS2.Activate

Application.ScreenUpdatingの内部だと動作しないのかな、とも思いましたが原因がよく分からないです。原因が分かる方、解決策をご教示いただければ幸いです。よろしくお願いいたします。

補足情報（FW/ツールのバージョンなど）

PC：Windows11
ソフト：Microsoft365 Excel
参考URL:エクセルの学校