エクセルでマクロを組み始めたばかりの者です。下記の

質問

エクセルでマクロを組み始めたばかりの者です。下記のようなマクロを組んでみましたが、27行目もしくは41行目のActiveSheet.Pasteで「実行時エラー‘1004‘： 変更しようとしているセルまたはグラフは保護されているため読み取り専用となっています…」というエラーメッセージが出て止まってしまいます。

しようとしている内容は、転送ボタンを押し各シートの指定セルへ一括転送（コピー）をしたいのです。
その際、転送先はシート保護をしておきたいのです。

エラーはエクセル2010で確認しましたが、職場のＰＣを使用するため2007や2003等他のバージョンを利用する可能性もあります。また、仕事で使用するため早急に使わなければならず焦っています。

Option Explicit
Private Sub CommandButton2_Click()
Call Macro2
End Sub

Sub Macro2()
Workbook.Open Filename:=”K:¥共有¥○○○.xlsm”
ActiveSheet.Unprotect
ThisWorkbook.Activate
Range(”D4:G20”).Select
Selection.Copy
Windows(”○○○.xlsm”).Activate
Range(”E7”).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False

Workbook.Open Filename:=”C:¥Users¥Desktop¥×××.xlsm”
ActiveSheet.Unprotect
ThisWorkbook.Activate
Range(”D4:G20”).Select
Selection.Copy
Windows(”×××.xlsm”).Activate
Sheet(”△△△”).Select
Range(”AF18:AI34”).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False

Workbook.Open Filename:=”K:¥共有¥□□□.xlsm”
ActiveSheet.Unprotect
ThisWorkbook.Activate
Range(”D4:G20”).Select
Selection.Copy
Windows(”□□□.xlsm”).Activate
Sheet(”▽▽▽”).Select
Range(”AF18:AI34”).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
ActiveWindow.Close
Application.CutCopyMode = False

MsgBox " 『○○○』と" & vbCrLf & "『×××』と" & vbCrLf & "『□□□』の" & vbCrLf & "規格を変更しました。"

End Sub

どの様に修正すれば良いのでしょうか？
マクロが原因でしょうか？または他の原因があるのでしょうか？
マクロ初心者のため、修正方法など具体的な詳細をお教えいただけないでしょうか。
お手数をおかけして申し訳ございませんが、よろしくお願いします。

回答No.1

ushi2015 · ベストアンサー

こんにちは
多分、保護の解除がうまくいってないのでは？
Sub Macro2()
　　Dim wbk1 As Workbook
　　Dim wsh1 As Worksheet
　　Dim tsh As Worksheet

　　Application.ScreenUpdating = False

　　Set tsh = ActiveSheet 'ThisWorkbook.Worksheets(1)?

　　Set wbk1 = Workbook.Open("K:\共有\○○○.xlsm")
　　Set wsh1 = wbk1.Worksheets(1) '○○○.xlsmのシートが1枚ならこのまま。複数ならシート名指定に変更

　　wsh1.Unprotect

　　tsh.Range("D4:G20").Copy wsh1.Range("E7")

　　wsh1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
　　wbk1.Save
　　wbk1.Close

　　Set wbk1 = Nothing

　　Set wbk1 = Workbook.Open("C:\Users\Desktop\×××.xlsm")
　　Set wsh1 = wbk1.Worksheets(1) '×××.xlsmのシートが1枚ならこのまま。複数ならシート名指定に変更

　　wsh1.Unprotect

　　tsh.Range("D4:G20").Copy wsh1.Range("AF18")

　　wsh1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
　　wbk1.Save
　　wbk1.Close

　　Set wbk1 = Nothing

　　Set wbk1 = Workbook.Open("K:\共有\□□□.xlsm")
　　Set wsh1 = wbk1.Worksheets(1) '□□□.xlsmのシートが1枚ならこのまま。複数ならシート名指定に変更

　　wsh1.Unprotect

　　tsh.Range("D4:G20").Copy wsh1.Range("AF18")

　　wsh1.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
　　wbk1.Save
　　wbk1.Close

　　Set wbk1 = Nothing

　　Application.ScreenUpdating = True

　　MsgBox " 『○○○』と" & vbCrLf & "『×××』と" & vbCrLf & "『□□□』の" & vbCrLf & "規格を変更しました。"

End Sub
動作確認してないですけど、これで試してみて下さい。

お礼

ありがとうございました。
無事解決しました。

回答No.3

ushi2015

こんにちは、No1です
何度も済みません。
選択しないで処理するならいいのですが、
もしどうしても選択が必要なら、そのセルのロックは外して有りますよね？

回答No.2

ushi2015

こんにちは、No1です
追加ですけど、
Protect で UserInterFaceOnly:=True で保護しておけば解除する必要も無い
かも知れませんので試して下さい。