こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

一行を他のシートの最終行に貼り付けたいのですが

同一ブック内のシート名「作業データ3」のA2からUO2までの値(日付、数値、商品名等の値が入っています。)をシート名「売上集計」のA2行目から順番に貼り付けたいのですが、うまくいきません。
「作業用データ3」にはシート名「入力フォーム」の値が「作業データ3」のA2からUO2の間で、1行に全部(参照セルの関数が入っているだけ)入ります。入力フォームを作成するたびに、「作業データ3」のA2の行に参照セルとして値が取り込まれます。

以下のマクロ文を作成しましたが、実行すると以下のエラーが出ます。
実行時エラー '1004"
RagngeクラスのPasteSpecial メソッドが失敗しました。
Activeworksheet.unprotect及びprotectの文言を消して、なおかつ売上集計シートの保護を解除すると、問題なく値のみ貼り付けが出来ます。売上集計シートはシートの保護を有効にしたいのですが、どうすればよろしいでしょうか?


Sub 売上集計保存()
'変数の宣言
Dim LstRow1 As Long
Dim LstRow2 As Long
'最終行の取得
LstRow1 = Worksheets("作業データ3").Cells(Rows.Count, 1).End(xlUp).Row
LstRow2 = Worksheets("売上集計").Cells(Rows.Count, 1).End(xlUp).Row
'タイトル行を除き、売上集計へコピー、貼り付け
Worksheets("作業データ3").Range("A2:UO2" & LstRow1).Copy
ActiveSheet.Unprotect
Worksheets("売上集計").Select
Worksheets("売上集計").Range("A" & LstRow2).Offset(1, 0).PasteSpecial xlPasteValues

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
MsgBox "保存しました。"
End Sub

投稿日時 - 2018-03-04 01:43:48

QNo.9434838

困ってます

質問者が選んだベストアンサー

パット見ですが、
Worksheets("作業データ3").Range("A2:UO2" & LstRow1).Copy
はおかしいです。
文章の通り、A2からUO2まで、2行目だけをコピーしたいのなら、
Worksheets("作業データ3").Range("A2:UO2").Copy
とすべきだし、2行目から最終行までコピーしたいのなら、
Worksheets("作業データ3").Range("A2:UO" & LstRow1).Copy
とすべきです。これでは、最終行の前に2を付けた行までがコピーの対象になってしまいます。(例えば、100 行までデータがあれば、2100行まで対象になる)
とりあえず、ここを直して動かしてみて下さい。

それでも動かない場合は、ワークブックそのものを見ないと何とも言えません。
どこかにアップロードしていただけたらと思います。

なお、値のコピーなら、このような書き方もあります。シートの選択をせずに、コピーできるので、何回もコピーするときは便利です。コピー先も範囲指定する必要があるので面倒ですが。
Worksheets("売上集計").Range("A" & LstRow2 + 1 & ":UO" & LstRow2 + LstRow1 - 1) = _
  Worksheets("作業データ3").Range("A2:UO" & LstRow1).Value

投稿日時 - 2018-03-04 02:26:10

お礼

ご回答いただき、ありがとうございます。 ご指摘いただいた箇所を、ご指示通り変更して、コピー動作がうまくいくことを確認しました。

単純に一行だけのコピーなので、確かに LstRow1は不要だったんですね。どおりで、コピー後、複数行が選択された表示になっていたので、なにかおかしいと思っていました。

以下の通り修正しました。他のシートからマクロボタンを実行しても、売上集計にうまく一行だけコピーされました。 それと値だけのコピーはCopyだけで足りるんですね。
Worksheets("作業データ3").Range("A2:UO2").Copy

Sub 売上集計保存()

'変数の宣言
Dim LstRow1 As Long
Dim LstRow2 As Long
'最終行の取得
LstRow1 = Worksheets("作業データ3").Cells(Rows.Count, 1).End(xlUp).Row
LstRow2 = Worksheets("売上集計").Cells(Rows.Count, 1).End(xlUp).Row

'タイトル行を除き、売上集計へコピー、貼り付け
Worksheets("作業データ3").Range("A2:UO2").Copy

Worksheets("売上集計").Select
Worksheets("売上集計").Range("A" & LstRow2).Offset(1, 0).PasteSpecial xlPasteValues
MsgBox "保存しました。"

End Sub

度々、ありがとうございます。 m(_ _)m

投稿日時 - 2018-03-04 13:44:22

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問