【Excel VBA】ブック内の全シートの選択セルをA1に変更するコード

目的

資料を提出する際、ブック内のすべてのシートをA1セルに移動させてから保存するのがマナーという人がいる。。。
手作業でやると地味に面倒で手間がかかる作業なので右クリックメニューに組み込んでみた。

完成コード

Option Explicit

Public Sub Create_RightClickMenu()
    
    'CommandBarタイプの種類を設定
    Dim CMB As Variant: CMB = Array("Cell", "Row", "Column")
    Dim RCM As CommandBar, CBB As CommandBarButton
    
    Dim I As Long
    For I = LBound(CMB) To UBound(CMB)
        
        '右クリックメニュー初期化（重複登録防止）
        Set RCM = Application.CommandBars(CMB(I)): RCM.Reset
        
        '右クリックメニューの追加
        Set CBB = RCM.Controls.Add(before:=1)
        CBB.Caption = "全シートA1に移動 (&A)"
        CBB.OnAction = "S_Select_AllWorksheet_A1Cell"
        
    Next I
    
End Sub

Public Sub Reset_RightClickMenu()

    Dim CMB As Variant: CMB = Array("Cell", "Row", "Column")
    
    Dim I As Long
    For I = LBound(CMB) To UBound(CMB)
        Application.CommandBars(CMB(I)).Reset
    Next I
    
End Sub

'**
'* ブック内のワークシートのセル番地をすべてA1に設定する
'**
Private Sub S_Select_AllWorksheet_A1Cell()
    
    '選択されているワークブック、ワークシートを変数に格納
    Dim WB As Workbook: Set WB = Selection.Parent.Parent
    Dim WS As Worksheet: Set WS = Selection.Parent
    
    'ループ処理で全てのワークシートをA1セルに移動処理
    Dim TmpWS As Worksheet
    For Each TmpWS In WB.Worksheets
        Application.Goto TmpWS.Range("A1")
    Next TmpWS
    
    '初期シートに戻る
    WS.Select
    
End Sub