シート名「作業データ3」から「売上集計」への値の貼り付けエラー

このQ&Aのポイント
  • 質問者はシート名「作業データ3」のA2からUO2までの値をシート名「売上集計」のA2行目から順番に貼り付けたいが、エラーが発生している。
  • マクロを作成したが、実行時エラー「1004」が発生し、PasteSpecialメソッドが失敗している。
  • シートの保護が有効な状態で値のみを貼り付ける方法を知りたい。
回答を見る
  • ベストアンサー

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

同一ブック内のシート名「作業データ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

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

  • ベストアンサー
  • SI299792
  • ベストアンサー率48% (715/1477)
回答No.1

パット見ですが、 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

shibushijuko
質問者

お礼

ご回答いただき、ありがとうございます。 ご指摘いただいた箇所を、ご指示通り変更して、コピー動作がうまくいくことを確認しました。 単純に一行だけのコピーなので、確かに 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

関連するQ&A

  • シート1のC列の最終行をコピーして同じ行に値貼り付けしたい

    シート1のC列の最終行を取得して その行を丸々値貼り付けするマクロを作りたいと思います。 シート3のB18の値をシート1のC列の最終行の1つ下のセルに値貼り付け すると、その行のA、B列に日付が入力される関数が入っています。(下まで) 関数が入ったままだと、うまくいかない時があるので最終行をコピーして値貼り付けしたいのですが、マクロの作り方を教えてください。 シート1の最終行に貼り付け Sheets("Sheet3").Select Range("B18").Select Selection.Copy Sheets("Sheet1").Select Range("C65536").End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub 最終行をコピーして値貼り付け Dim 最終行 As Integer 最終行 = Range("C65536").End(xlUp).Row Range("A6:C" & 最終行).Select Selection.Copy Sheets("Sheet1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False End Sub このマクロだと、A6からC列の最終行まで全てコピーされてしまうので、C列の最終行のAからC列まで1行だけコピーできないでしょうか?

  • 他のシートの任意の列に1行おきに表示する

    よろしくお願いします。 下の構文ですと Worksheets("入力")の3列目5行目以降のデーターが Sheet2の同じ列(3列目)5行目以降に1行おきに表示されます。 これを Worksheets("入力")の3列目5行目以降のデーターを Sheet2の7列目5行目以降に1行おきに表示したいのですが どのように書き直せばよいでしょうか。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i As Long, j As Long j = 5 With Worksheets("入力") For i = 5 To .Cells(Rows.Count, 3).End(xlUp).Row .Rows(i).Copy Worksheets("Sheet2").Cells(j, 1) j = j + 2 Next i End With End Sub

  • 長いマクロ文をdo whileで簡潔にするには

    お得意先ごとに月末に一括で請求書を自動作成・保存・印刷するマクロを作りました。しかし、あまりにもマクロ文が長いので短くしたいと考えています。 現状、シート名「今月処理件数」上のマクロ”請求書一括印刷”を押すと該当月の一社ごとの売上が保存され、請求書作成、印刷まで実行されます。このシートのA列A2からその下に該当月に取引のあった会社コードが入ります。A71を最終行としています。A2がkprint1~A71がkprint70までのマクロ文を作っています。 「今月処理件数」上のマクロ”請求書一括印刷”及び"kprint1~kprint70"のマクロ文を do while か for next文で書き換えて短くする方法はありますでしょうか。 ※シート名「作業データ1」及び「作業データ3」は一時作業シートです。他のシートは請求書保存、会社ごとの売掛情報保存に必要なシートです。 Sub 請求書一括印刷() '実際にはkprint1~kprint70までありますが、kprint3までで割愛しています。 Select Case True Case Range("a2") = "" MsgBox "印刷データがありません。" Case Range("a3") = "" Call kprint1 MsgBox "印刷しました。" Case Range("a4") = "" Call kprint1 Call kprint2 MsgBox "印刷しました。" Case Range("a5") = "" Call kprint1 Call kprint2 Call kprint3 MsgBox "印刷しました。" End Select End Sub kprint1からkprint70まで作成しています。kprint1は「今月処理件数」のA2の会社コードの処理です。kprint2はA3の会社コードの処理、それ以降、A71までの会社コートを想定してkprint70まで作っています。 Sub kprint1() Application.ScreenUpdating = False ThisWorkbook.Worksheets("請求書データベース").Unprotect ThisWorkbook.Worksheets("今月処理件数").Unprotect Worksheets("今月処理件数").Range("A2").Copy Worksheets("請求書データベース").Range("AD1") Range("D2").Value = "印刷済み" Call 条件フィルタ2 '請求書データベースA列(会社コード)を解除する Call 条件フィルタ1 '請求書データベースAD1に入力された会社コードを使ってA列(会社コード)からAD1の会社コードを取得する ThisWorkbook.Worksheets("今月処理件数").Protect ThisWorkbook.Worksheets("請求書データベース").Protect AllowFiltering:=True ThisWorkbook.Worksheets("請求書データベース").Unprotect Range("A1").Select Selection.CurrentRegion.Select 'アクティブシートの切り替え ActiveWorkbook.Worksheets("作業データ1").Activate 'アクティブシートの図形・画像を全て削除 ActiveSheet.DrawingObjects.Delete 'アクティブシートの内容を全て削除 ActiveSheet.Cells.Clear 'アクティブシートのコメントを全て削除 ActiveSheet.Cells.ClearComments Sheets("請求書データベース").Select Selection.Copy Sheets("作業データ1").Activate Range("A1").Select ActiveSheet.Paste Call 売上一覧入力  '請求書データベースのフィルタ検索結果の可視行をすべて作業データ1に貼り付ける Call 売上集計保存2  '一時作業シート「作業シート3」の内容を「売上集計」に貼り付ける  Sheets("請求書データベース").Select ActiveSheet.Protect AllowFiltering:=True Sheets("請求書3").Visible = True Sheets("請求書3").Select Call print_nohin1 Sheets("請求書3").Visible = False Sheets("今月処理件数").Select Application.ScreenUpdating = True End Sub 上記"kprint1"に出てくる、callステートメントのマクロの内容は以下の通りです。 Sub 条件フィルタ1() Worksheets("請求書データベース").Select ActiveSheet.Range("$A$1").AutoFilter Field:=1, Criteria1:=Range("AD1") 'AD1の値でA列の会社コードにフィルターをかける End Sub Sub 条件フィルタ2() Worksheets("請求書データベース").Select ActiveSheet.Range("$A$1").AutoFilter Field:=1 'A列の会社コードのフィルター解除 End Sub Sub 売上一覧入力() ' 売上一覧入力 Macro' ActiveWorkbook.Worksheets("作業データ1").Activate GYOU = Sheets("売上一覧表").Range("B65536").End(xlUp).Offset(1, 0).Row '「売上一覧表」には会社コード、会社名、売上金額、入金情報がコピーされる。 Sheets("売上一覧表").Cells(GYOU, 1).Value = Range("X2").Value Sheets("売上一覧表").Cells(GYOU, 2).Value = Range("P2").Value Sheets("売上一覧表").Cells(GYOU, 3).Value = Range("C2").Value Sheets("売上一覧表").Cells(GYOU, 4).Value = Range("Q2").Value Sheets("売上一覧表").Cells(GYOU, 5).Value = Range("R1").Value Sheets("売上一覧表").Cells(GYOU, 6).Value = Range("S1").Value Sheets("売上一覧表").Cells(GYOU, 7).Value = Range("T1").Value Sheets("売上一覧表").Cells(GYOU, 8).Value = Range("U1").Value Sheets("売上一覧表").Cells(GYOU, 9).Value = Range("V1").Value Sheets("売上一覧表").Cells(GYOU, 10).Value = Range("W1").Value Sheets("売上一覧表").Cells(GYOU, 11).Value = Range("Y2").Value End Sub Sub 売上集計保存2() '変数の宣言 Dim LstRow1 As Long Dim LstRow2 As Long '最終行の取得 Worksheets("作業データ3").Activate '作業データ1の2行目から80行目までの内容をすべて、作業データ3の2行目に取得する。 LstRow1 = Worksheets("作業データ3").Cells(Rows.Count, 1).End(xlUp).Row LstRow2 = Worksheets("売上集計").Cells(Rows.Count, 1).End(xlUp).Row 'タイトル行を除き、売上集計へコピー、貼り付け Worksheets("作業データ3").Range("A2:ZM2").Copy Worksheets("売上集計").Select Worksheets("売上集計").Range("A" & LstRow2).Offset(1, 0).PasteSpecial xlPasteValues Worksheets("今月処理件数").Select End Sub Sub print_nohin1() ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _ :=True, IgnorePrintAreas:=False '請求書は繰越額や請求金額の数字だけなので、1ページのみの印刷 End Sub

  • シート間の値の貼り付け。 スマートにしたい。

    こんばんは。 エクセルのシート1の[d7]から シート2の[最終行]からカウントした数分(下の場合はシート1[d7]の値をc列に3行分)貼り付けるには下記のコードでOKと伺ったのですが、 この作業を何度も繰り返しさせているうちに動作が重くなってしまったような気がするのでが、シート1の[b2](貼り付け時に日付)[b3](VLOOKUPの計算式が入っているので値のみ)[b4](時刻)の形式でシート2のそれぞれ、隣接するd,e,l列に3行づつ貼り付けたいのですが、 何か方法は、ありますでしょうか。(それぞれ貼り付けたい形式も異なります。) n=3 Worksheets("Sheet1").Range("d7").Copy _ Destination:=Worksheets("Sheet2").Range("c65536").End(xlUp).Offset(1, 0).Resize(n, 1) ↓動作確認ができなくなってしまったので、試していないのですが、 上の式の値のみ貼り付け方法は下記でよいのでしょうか。 '値のみ貼り付け Set WWR1 = Worksheets("Sheet1").Range("c7") Set WWR2 = Worksheets("月度集計").Range("c65536").End(xlUp).Offset(1, 0).Resize(n, 1) WWR2.Value = WWR1.Value 宜しくお願い致します。

  • 複数のシートの値を一つのシートに整列

    よろしくお願いします。 複数のシートに行も列もバラバラになっているデータを一つのシートの行に整列させたいと思っています。 具体的には下記のようなシートがあります。一つは組織の名前のシート、一つは組織の基礎情報といった感じでシートごとに回答されています。 これを他のシートに一つの組織を一つの行で整列させ分析をしていきたいと思っています。 ファイルが数千あるため、マクロで書こうと思っているのですが、下記のように書いたのですがうまくいきません。 アドバイスをいただけないでしょうか? ファイルは(アンケートデータ1,アンケートデータ2といった感じで統一、作業フォルダ内にすべて保存) マクロを動かすセルは”統合”というファイル名、シート1に持ってきます。 Sub Macro1() Dim i As Integer For i = 1 To 1000 'アンケートデータファイルを開く Workbooks.Open Filename:="C:\Documents and Settings\Administrator\My Documents\作業\アンケートデータ" & i" .xls 'アンケートデータファイル 学校名シートのB11 を新しいブックのシート1のA1にコピー Worksheets(学校名).Activate Range("B11").Select Worksheets(統合).Activate ActiveSheet.Paste ThisWorkbook.Worksheets(1).Range("A" & i).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True Worksheets(基本データ).Activate Range("D3").Select Worksheets(統合).Activate ActiveSheet.Paste ThisWorkbook.Worksheets(1).Range("B" & i).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True Worksheets(基本データ).Activate Range("D6").Select Worksheets(統合).Activate ActiveSheet.Paste ThisWorkbook.Worksheets(1).Range("C" & i).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=True 'アンケートデータファイルを閉じる ActiveWorkbook.Saved = True ActiveWorkbook.Close Next i End Sub 最終的には統合ファイル内で      A(学校名)         B(学校区分)    C(広さ)   D経営状況   E   F 1列  アイウエオ学校       3             500    黒字 2列    といった感じで学校数文行で並ぶようにしたいのです。 上記の式の間違いの指摘、書き方についてアドバイスをください。

  • VBA:Offsetから値が貼付けれない

    はじめまして。 VBAを利用してマクロを作っているのですが、 Range("a6:l6").Copy Worksheets("結果シート").Range("A65536").End(xlUp).Offset(1) というのは動くのですが、結果シートへの貼付けを「値」で行いたいと思い、 以下の通りValueを指定しても動きません。 Range("a6:l6").Copy Worksheets("結果シート") .Range("A65536").End(xlUp).Offset(1).value PasteSpecialを使うと良いのかと思い、 Range("a6:l6").Copy Worksheets("結果シート") .Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues としてもエラーが出ます。 数式の結果を取得して、別のシートの空白セルを探し、「値」として張付ける。 というのがしたいのですが、なにか上手い方法があれば、ご教授お願いします。

  • 複数シートをループさせてマクロを簡素化したい

    win7 Excel2007 でマクロ作成中の初心者です。 シート数の変動する複数シートの特定範囲を一枚のシートに右列方向に、値を貼り付けたいです。 自動記録でコード作成しましたが、もっと簡素化して軽くしたいです。 シートに対するループ等の作成ができません。どうかご指導お願いします。 Sub 勤怠最終データ作成() Worksheets(1).Select '1番左のシートを選択 ActiveSheet.Unprotect Range("B29:BM60").Select '複写範囲はすべて同じ Selection.Copy Sheets("総括").Select '値の貼り付けシートはすべて同じ Range("A2").Select '値の貼り付け先 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(2).Select '2枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 '値の貼り付け先 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(3).Select '3枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 Selection.PasteSpecial Paste:=xlPasteValues ’-------------------------------------- Worksheets(4).Select '4枚目のシートを複写 ActiveSheet.Unprotect Range("B29:BM60").Select Selection.Copy Sheets("総括").Select 最終セルの選択 Selection.PasteSpecial Paste:=xlPasteValues 以下省略 End Sub

  • VBA 新データ行のみ元のデータシートにコピーする

    OSは、XP Excelは、2003 を使用しています。 シート1には元のデータ、シート2には追加データと元データが混じってあります。 元データシートに、追加データシートから追加データ行のみをコピペしたく、 マクロを組んでいます。 下記、 C列の売上番号を見比べて、C列のみ追記するまでは出来たのですが、 1行にデータはA列~X列まであるので、そのデータも一緒にコピペするには どの様にすれば良いのか教えて下さい。 よろしくお願いします。 ****************** Sub 追加データ追記マクロ() Dim motows As Worksheet '元データシート名を格納 Dim tsuikaws As Worksheet '追加データシート名を格納 Dim tsuikamax As Long '追加データの最終行 Dim motomax As Long '元データの最終行 Dim tsuikaNum As Range '追加売上番号 Dim motoNum As Variant '元売上番号 Dim i As Long     '書き込み行 Set motows = Worksheets(1).Name '元シート名を格納 Set tsuikaws = Worksheets(2).Name    '追加シート名を格納 tsuikamax = tsuikaws.Cells(Rows.Count, 1).End(xlUp).Row  '追加データの最終行を格納 motomax = motows.Cells(Rows.Count, 1).End(xlUp).Row '元データの最終行を格納 i = motomax + 1       '書き込み行は元データ最終行+1 For Each tsuikaNum In tsuikaws.Range("C1:C" & tsuikamax)        '追加データ売上番号格納 Set motoNum = motows.Range("C:C").Find(tsuikaNum, lookat:=xlWhole) '元データ売上番号格納 If motoNum Is Nothing Then '元データになかったら With motows .Cells(i, 3) = tsuikaNum i = i + 1 End With End If Next tsuikaNum End Sub

  • VBA 最終行を選んだシートにコピーする。

    VBAど初心者です。どうしても最終行のデータを選んだシートにコピーできません。 LastRow.Selectのところで、止まってしまいます。どのように行を設定していいのかさっぱりわかりません。どなたか、ご指導のほどよろしくお願いします。 Sub copy_last_line() Dim LastRow As Long Sheets("Sheet1").Select LastRow = Cells(Rows.Count, 1).End(xlUp).Row LastRow.Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Sheets("Sheet1").Select Range("A1").Select End Sub

  • VBA 他のブックから複数のシートのデータをコピー

    VBA初心者です。 他のブックの複数のシートの最終行のデータをコピーし1つのシートにまとめたいと思っています。 参照元 シート1 最終行20 AからD シート2 最終行30 AからD シート3 最終行15 AからD のそれぞれのデータ メインシート 1行目 シート1のAからD 2行目 シート2のAからD 3行目 シート3のAからD を値のみ貼り付けたいです 色々と検索しチャレンジするシート1のみであればなんとか成功するまで完成したのですが、インデックスが有効ではありませんとでてエラーがでます。原因は、シート2のデータをコピーする際、参照元のファイルがActiveになっていないからだと考えているのですが、参照元のファイル名が毎回違いますので、ファイルを選択してファイルを開いてから作成しようとチャレンジしています。 Sub Copy() 'コピー元のファイルを選択して開く Dim OpenFile As String ChDir "C:\Users\name\Documents\folder" OpenFile = Application.GetOpenFilename("Excelブック,*.xlsx") MsgBox OpenFile & " を開きます" Workbooks.Open FileName:=OpenFile 'データをコピー 'シート1 Worksheets("シート1").Range("A20:D20").Copy Workbooks("メインブック.xlsm").Worksheets("メインシート").Activate Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'シート2 Worksheets("シート2").Range("A30:D30").Copy Workbooks("メインブック.xlsm").Worksheets("メインシート").Activate Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 良きアドバイスよろしくお願いします。

専門家に質問してみよう