'=========================================================================================
' 176 （異なるシートで）指定したセル範囲の値を等しくする
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim コピーシート As String                      '★★★ コピーするシート名
Dim 貼付シート As String                        '★★★ 貼り付けするシート名
Dim コピー範囲 As Range                         '★★★ コピー範囲セット用
Dim 貼付範囲 As Range                           '★★★ 貼り付け範囲　〃
Dim 左 As Integer
Dim 上 As Long
Dim 右 As Integer
Dim 下 As Long
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant


'=========================================================================================
Sub 指定したセル範囲の値を等しくする_異なるシート()     '★★★
    Worksheets(コピーシート).Activate                'シートをアクティブにする
        Set コピー範囲 = Worksheets(コピーシート).Range(Cells(上, 左), Cells(下, 右)) 'コピー範囲をセット
    Windows("176.XLS:1").Activate                   'おためし用のコードにつき実務では不要
    Worksheets(貼付シート).Activate                  'シートをアクティブにする
        Set 貼付範囲 = Worksheets(貼付シート).Range(Cells(上, 左), Cells(下, 右)) '貼り付け範囲セット
        貼付範囲.ClearContents                       '値をクリアしておく
        貼付範囲.Value = コピー範囲.Value             '貼り付け範囲の値をコピー範囲の値と等しくする
End Sub
'-----------------------------------------------------------------------------------------
Sub 指定したセル範囲の値を等しくする_同一シート()       '★★★ 参考
    Worksheets(コピーシート).Activate                'シートをアクティブにする
        Set コピー範囲 = Range(Cells(上, 左), Cells(下, 右)) 'コピー範囲をセット
        Set 貼付範囲 = Range(Cells(上, 左 + 3), Cells(下, 右 + 3)) '貼り付け範囲セット
        貼付範囲.Clear                               'クリアしておく
        貼付範囲.Value = コピー範囲.Value             '貼り付け範囲の値をコピー範囲の値と等しくする
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    おためしメッセージを表示する
    Windows("176.XLS:2").Activate
'
    コピーシート = "Title"                      '★★★ コピーするシート名
    左 = 2                                      '★★★ 範囲の左上セルの列
    上 = 4                                      '★★★ 　　　　〃　　　行
    右 = 13                                     '★★★ 範囲の右下セルの列
    下 = 4                                      '★★★ 　　　　〃　　　行
    貼付シート = "Sheet2"                       '★★★ 貼り付けするシート名
    指定したセル範囲の値を等しくする_異なるシート   '★★★
'
    マルチ画面表示を戻す
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    Worksheets("Sheet2").Range("B4:M4").Value = "" '初期化する
    おためし用にマルチ画面表示する
    Windows("176.XLS:1").Activate
    Worksheets("Sheet2").Select
        Range("B4:M4").Select                   'タイトルの行を選択する
        タイトル = "500連発 第2弾 サンプルマクロ"
        スタイル = 64                           'vbInformation
        メッセージ = "下のシートは Sheet2で、" & Chr(13) & Chr(13) & _
                    "選択中のセル範囲（B4:M4）には、タイトルがありません"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
    Windows("176.XLS:2").Activate
    Worksheets("Title").Select
        メッセージ = "下のシートのセル範囲 B4:M4の値を、" & Chr(13) & Chr(13) & _
                    "上のシートの B4:M4 の値（タイトル）と等しくします"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'-----------------------------------------------------------------------------------------
Sub おためし用にマルチ画面表示する()
    ActiveWindow.WindowState = xlMaximized
    Sheets("Sheet2").Select
        ActiveWindow.NewWindow                  '新しいウィンドウを開く
    Windows.Arrange ArrangeStyle:=xlHorizontal  'ウィンドウを上下に並べて表示する
    Sheets("Title").Select
    Windows("176.XLS:1").Activate
    ActiveWindow.DisplayHeadings = True         '行列番号を表示する
End Sub
'-----------------------------------------------------------------------------------------
Private Sub マルチ画面表示を戻す()
    メッセージ = "画面を戻します"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
'
    Windows("176.XLS:1").Activate
    ActiveWindow.DisplayHeadings = False
    Windows("176.XLS:2").Close
    Sheets("Title").Select
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.WindowState = xlMaximized
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------