読み取り専用ブックを別に生成

'--------------------------------------------------
'プロシージャの概要:
'処理名:プロシージャA
'概要:ブックを複製して読み取り専用で開き、元ブックのA1セルをクリアして保存閉じる
'--------------------------------------------------
Sub procedureA()
    
    Dim wbOriginal As Workbook
    Dim wbReadOnly As Workbook
    Dim wsTarget As Worksheet
    Dim strSheetName As String
    
    ' エラーハンドリング開始
    On Error GoTo ErrorHandler
    
    ' 前段の処理（省略）
    ' ...
    
    ' 変数初期化
    Set wbOriginal = ThisWorkbook
    strSheetName = "シートA"
    
    ' 元ブックをコピーして新しいブックを作成
    wbOriginal.Activate
    Set wbReadOnly = Workbooks.Add
    wbOriginal.Worksheets.Copy Before:=wbReadOnly.Worksheets(1)
    
    ' 新しいブックの不要なシートを削除
    Application.DisplayAlerts = False
    wbReadOnly.Worksheets("Sheet1").Delete
    Application.DisplayAlerts = True
    
    ' 読み取り専用ブック（ブックB）を読み取り専用推奨に設定
    wbReadOnly.ReadOnlyRecommended = True
    
    ' 読み取り専用ブックをアクティブにする
    wbReadOnly.Activate
    
    ' 元ブック（ブックA）でA1セルをクリアして保存
    wbOriginal.Activate
    Set wsTarget = wbOriginal.Worksheets(strSheetName)
    wsTarget.Range("A1").Clear
    
    ' 元ブックを保存して閉じる
    wbOriginal.Save
    wbOriginal.Close SaveChanges:=False
    
    ' 読み取り専用ブックをアクティブにして処理完了
    wbReadOnly.Activate
    
    Exit Sub
    
ErrorHandler:
    ' エラー情報を表示
    MsgBox "ブック処理でエラーが発生しました。" & vbCrLf & _
           "エラー番号: " & Err.Number & vbCrLf & _
           "エラー内容: " & Err.Description, _
           vbCritical, "エラー"
    
    ' DisplayAlertsを元に戻す
    Application.DisplayAlerts = True
    
    ' エラー情報をクリア
    Err.Clear
    
End Sub