エクセルでマクロをし始めたばかりのため、皆様にお教え頂きたいです。1度質問させて頂きましたが上手く

Question

エクセルでマクロをし始めたばかりのため、皆様にお教え頂きたいです。
1度質問させて頂きましたが上手くいかず再度質問させて頂きました。

今開いいるシートに転送ボタンを作成します。このシートのセルC4からC27まで、もしくはC23までのデータ(言葉や数値など)を、ボタンを押して、Cドライブ共有フォルダ内のマクロというブック、様式1ならびに2の名前のシートにセルB9,C9,D9…といったように縦並びから横並びに変えて毎日までに転送しようと思います。(行と列を入れ替えて2シート一括転送コピー。)
その際、転送先はシート保護をしておきたいのです。

Option Explicit
Private Sub CommandButton1_Click()
Call Macro1
End Sub

Sub Macro1()
Dim GYOU As Long

ActiveSheet.Unprotect

Workbook.Open Filename:=”C:¥共有¥マクロ.xlsx”
ThisWorkbook.Activate
With Workbooks(”マクロ.xlsx”)

GYOU = .Sheets(”様式1”).Range(”A” & Rows.Count).End(xlUp).Row + 1
.Sheets(”様式1”).Range(”A” & GYOU & ”:AA” & GYOU + 1880).Value
=Sheets(”様式1”).Range(”A2:AA2000”).Value

GYOU = .Sheets(”様式2”).Range(”A” & Rows.Count).End(xlUp).Row + 1
.Sheets(”様式2”).Range(”A” & GYOU & ”:W” & GYOU + 1880).Value
=Sheets(”様式2”).Range(”A2:W2000”).Value

Application.CutCopyMode = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Close SaveChanges:=True

End with
Range(”A2:AA6000”).Value=””

End Sub


この様なマクロを組んでみましたがエラーメッセージが出て、止まってしまいます。
【エラー内容】
変更しようとしているセルまたはグラフは保護されているため、読み取り専用となっています。…
というコメントが出て、
.Sheets(”様式1”).Range(”A” & GYOU & ”:AA” & GYOU + 1880).Value
=Sheets(”様式
に黄色いラインが入ります。


どの様に修正すれば良いのでしょうか？
お手数をおかけして申し訳ございませんが、よろしくお願いします。

GooUserラック · Accepted Answer

あわせて作り直しました。ただ「Range(”A2:AA6000”).Value=””」はどのシートか判らないので省きました。
---------------------------------------------------------------
Sub Macro1()

Dim GYOU As Long

Workbooks.Open Filename:="C:\共有\マクロ.xlsx"
  With Workbooks("マクロ.xlsx")
  
    .Sheets("様式1").Select
    ActiveSheet.Unprotect
    GYOU = .Sheets("様式1").Range("A" & Rows.Count).End(xlUp).Row + 1
    ThisWorkbook.Activate
    Sheets("様式1").Select
    Range("A2:AA2000").Select
    Selection.Copy
    .Activate
    Range("A" & GYOU).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    .Sheets("様式2").Select
    ActiveSheet.Unprotect
    GYOU = .Sheets("様式2").Range("A" & Rows.Count).End(xlUp).Row + 1
    ThisWorkbook.Activate
    Sheets("様式2").Select
    Range("A2:W2000").Select
    Selection.Copy
    .Activate
    Range("A" & GYOU).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    
    Application.CutCopyMode = False
    .Close SaveChanges:=True
    
  End With

End Sub
---------------------------------------------------------------

くんこば · Answer

あー、分かった。
シートが二つあるんですね。
てことは、シートごとに保護の解除をしてやる、と。
http://officetanaka.net/excel/vba/sheet/sheet07.htm

くんこば · Answer

あ、間違えた。
.Sheets(”様式1”).Activate
.Sheets(”様式1”).Unprotect
です。

スマホだと、操作しづらい…

くんこば · Answer

すいません。
記述されてました。
With Workbooks(”マクロ.xlsx”)のあとに
.activate
.Unprotect
でいけるんじゃないですかね？

GooUserラック · Answer

前にも書きましたが「ActiveSheet.Unprotect」の場所が違います。
「Workbook.Open Filename:=”C:¥共有¥マクロ.xlsx”」と
「ThisWorkbook.Activate」の間です。

「マクロ.xlsx」のシート保護を解除するわけですよね。
だったら、いつ、このシートがアクティブ（前面）に来るかを考えてください。
貼り付け側に複数のシートがある場合は、それぞれのシートを「Select」した上で「ActiveSheet.Unprotect」する必要もあるかもしれません。

くんこば · Answer

現在シートを保護してるんですよね？
だから貼り付けられないんです。
なので、貼り付け前に「保護を解除」して貼り付け、保存前に「保護する」と。
これをVBAで組めばいいだけです。
どちらも一文でいけます。

エクセルでマクロをし始めたばかりのため、皆様にお教え頂きたいです。1度質問させて頂きましたが上手く

あわせて作り直しました。

あー、分かった。

あ、間違えた。

すいません。

前にも書きましたが「ActiveSheet.Unprotect」の場所が違います。

現在シートを保護してるんですよね？

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング