EXCEL データを別シートに貼り付ける方法

このQ&Aのポイント
  • EXCEL データをコピーして別シートの最初の空白行に貼り付ける方法について質問があります。
  • Sheet1 のデータを Sheet2 の最初の空白行に貼り付けるマクロを使用していますが、Sheet3 への貼り付け時にエラーが発生しています。詳細な解決方法について教えてください。
  • マクロを使用して、1つのブック内の複数のシートにデータを貼り付けたいと考えていますが、3つ目のシートへの貼り付け時にエラーが発生しています。エラーの原因と解決方法を教えてください。
回答を見る
  • ベストアンサー

再質問 EXCEL データをコピーして別シートの最初の空白行に貼り付け

再質問 EXCEL データをコピーして別シートの最初の空白行に貼り付けたい QNo.6023986でEXCEL データをコピーして別シートの最初の空白行に貼り付けたいと書き込んだものです。 質問内容は以下の通りです。 Sheet1はA列からR列までを使ったシートで、1行目は各項目があり、2行目からは当月のデータが入力されています。 Sheet2はSheet1の1行目と同じようにA列からR列までが項目になっていて、期中のデータを付け足していきたいと思っています。 マクロの記録でやってみたのですが、前月の最後の行(貼り付ける最初の空白行)の認識の仕方が分からず、Sheet2への貼付がうまくいきません。 どのような方法でやったらいいのか教えて下さい。 ----------------------------------------------------------------------------------- 回答で以下のマクロを教えていただき、テストではうまくいったのですが、 ひとつのブック内でsheet1をsheet2に、sheet3をsheet4に、sheet5をsheet6にと行いたいので、 以下のコードのシート名をそれぞれ書き換えてやってみました。 ところが、1を2にはできたのですが、3を4でやってみたところ、 なんどやっても『400』というエラーが出てしまいます。 シート名の他にも書き換えが必要なのか教えてください。 よろしくお願いします。 Sub Macro1() GYOU1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row GYOU2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("Sheet1").Select Range(Cells(2, 1), Cells(GYOU1, 18)).Copy Sheets("Sheet2").Select Range("A" & GYOU2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub

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

  • ベストアンサー
  • mar00
  • ベストアンサー率36% (158/430)
回答No.25

お詫び こちらから回答させてもらったマクロは どれも動作確認して問題なく動作したものです。 しかしorange1010さんの方では正しく動作しないという事で 原因はなにかと色々考えましたが、こちらで同じ問題がおこらないので どうしてなのかわかりません(私の力量不足です。) もう一度、改めて質問して他の人の知恵を借りた方が解決するのも 早いと思います。 解決出来ないままなのは本当に残念ですが、orange1010さんも 早く解決させたいと思いますので、回答するのを終わりにさせてもらいます。 本当に申し訳ないです。すいません。

orange1010
質問者

お礼

今までこんなにお付き合いいただいただけでも助かりました。 ありがとうございました。

その他の回答 (24)

  • mar00
  • ベストアンサー率36% (158/430)
回答No.4

動作確認しました。 正しく動作するのですが、エラーが出た時に終了ではなく デバッグを選択してください。 黄色くなっているところがエラーの原因になっているところなので その部分を教えて下さい。 ANo.2はシート名かsheet1とかsheet2という事を前提にしていましたので X = InputBox("元データを入力して下さい。") WS1 = "Sheet" & X y = InputBox("コピー先を入力して下さい。") WS2 = "Sheet" & y の部分を x = InputBox("元データを入力して下さい。") WS1 = x y = InputBox("コピー先を入力して下さい。") WS2 = y にして下さい。 砂時計が出ていても気にせずにシート名を入力しても大丈夫です。

orange1010
質問者

お礼

ありがとうございます。 教えて頂いた通り、以下のようにしました。 元データのシート名を1-1、コピー先のシート名を1-4として実行してみたところ、 Range("A" & GYOU2).Select の所で400というエラーが出てしまいます。 ステップインをしてみたところ、同じRange("A" & GYOU2).Select の所で、 実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーとなっていました。 シートの方はどちらともシート1-4のD3のセルがアクティブセルになっていました。 本当にお手数をお掛けしてしまって申し訳ないのですが、 どのようにしたらいいのか教えて下さい。 Sub Macro1() x = InputBox("元データを入力して下さい。") WS1 = x y = InputBox("コピー先を入力して下さい。") WS2 = y GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(WS1).Select Range(Cells(2, 1), Cells(GYOU1, 18)).Copy Sheets(WS2).Select Range("A" & GYOU2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub

  • mar00
  • ベストアンサー率36% (158/430)
回答No.3

本当に何度もすいません。 入力後OKのところは OKをクリックするか、またはEnterです。

  • mar00
  • ベストアンサー率36% (158/430)
回答No.2

何度もすいません。 Sub Macro1() X = InputBox("元データを入力して下さい。") WS1 = "Sheet" & X y = InputBox("コピー先を入力して下さい。") WS2 = "Sheet" & y GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(WS1).Select Range(Cells(2, 1), Cells(GYOU1, 18)).Copy Sheets(WS2).Select Range("A" & GYOU2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub InputBoxを使って変更するようにしました。 Sheet3からSheet4にデータを写す時は最初に出てくる InputBoxに3と入力後OK 次に出てくるInputBoxに4と入力後OK にすればいちいちマクロを修正する必要もなくなります。

orange1010
質問者

お礼

おはようございます。 昨夜はずっと格闘していて見に来れず、申し訳ありませんでした。 昨夜までの状況が、新しく教えていただいたコードを貼って、 シート名を既存のものに変更して走らせてみたのですが、 何度やり直しても400と出てしまうといったところです。 ちなみに書き換えたコードは以下の通りです。 Sub 派_ぴぼ継ぎ足し() WS1 = "派_貼" WS2 = "派_ぴ元" GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(WS1).Select Range(Cells(2, 1), Cells(GYOU1, 18)).Copy Sheets(WS2).Select Range("A" & GYOU2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub ------------------------------------------------------------------------------- また、今朝こちらを拝見して、次のコードでやってみたところ、 元データを入力してくださいとのメッセージの後、 砂時計状態のままで何もすることが出来ずにいます。 砂時計にならない場合の元データの指定方法も合わせて教えていただけないでしょうか? お手数をお掛けしてしまい、本当に申し訳ないのですが、 もう少しお付き合いいただけたらと思います。 よろしくお願いいたします。

  • mar00
  • ベストアンサー率36% (158/430)
回答No.1

Sub Macro1() WS1="Sheet1" ここを変える WS2="Sheet2" ここを変える GYOU1 = Sheets(WS1).Cells(Rows.Count, 1).End(xlUp).Row GYOU2 = Sheets(WS2).Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets(WS1).Select Range(Cells(2, 1), Cells(GYOU1, 18)).Copy Sheets(WS2).Select Range("A" & GYOU2).Select ActiveSheet.Paste Application.CutCopyMode = False End Sub ほかのシートでも行うと思っていなかったので WS1とWS2を変えれば出来るようにしました。

orange1010
質問者

お礼

ありがとうございます。 こちらの質問の仕方が悪くお手数をおかけしてしまいました。 申し訳ありません。 早速、やってみたいと思います。 まずはお礼まで。

関連するQ&A

  • 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

  • Excel VBAの質問。行のコピーと削除について

    Excel VBAでSheet1のD列に「処分」という文字が入力されていたら、その行を Sheet2へコピーし、Sheet1のその行を削除するというマクロを作成したいのですが、 削除をさせる位置が悪いのか件数が合いません。 下の例では、Sheet1のD列には「処分」という文字が入力されている行が3行あります。 Sheet1の1,3,4行目をSheet2へコピーした後にSheet1の1,3,4行目を削除して 行を上に詰めたいのです。 ネットで検索したり、書籍を読みながらここまで作成したのですが、どうしてもうまくいきません。 大変困っております。どうか、間違えている箇所を教えてください。よろしくお願いします。 A B C D E F -|----------------------------------------- 1| 1 03/01 時計 処分 倉庫 特になし 2| 2 03/05 電話 保留  倉庫 連絡済 3| 3 03/10 紙袋 処分 売店  使用済み 4| 4 03/11 電池 処分  倉庫 空白 5| 5 03/12 時計 保留  売店  空白 Private Sub cmdmSyobun_Click() Dim SyobunWord As String Dim gyou As Long Dim word As String Dim LastRow As Long Dim hantei As Integer Dim count As Integer Dim baseB As Workbook Dim baseS As Worksheet SyobunWord = "処分" Set baseB = ThisWorkbook Set baseS = baseB.Worksheets("Sheet1") baseS.Activate With Worksheets("Sheet1") hantei = MsgBox("「処分」データを移動しますか?", vbYesNo) Select Case hantei Case vbYes count = 0 gyou = 2 LastRow = baseS.Cells(Rows.count, 1).End(xlUp).Row Do While Cells(gyou, 4) <> "" word = Cells(gyou, 4) If InStr(word, MoveWord) >= 1 Then count = count + 1 Rows(gyou).Copy Worksheets("Sheet2").Cells(Rows.count, 1).End(xlUp).Offset(1, 0) Rows(gyou).Delete Shift:=xlShiftUp End If gyou = gyou + 1 Loop Case vbNo MsgBox "「処分」データは移動されませんでした。" End Select End With MsgBox MoveWord & "は、" & count & "件でした。" End Sub

  • エクセル VBA 特定文字がある行を別シートに移動

    ソフト excel2003 o列に文字列が入力された表があります。 マクロ実行時下記のようにするには、VBAのコードをどのように記入すればよろしいでしょうか? 赤枠で囲んだボタンをクリックすると シート1のO列に 中 が入力されている行を切り取りし中シートに貼り付け (下の行は上方向にシフト) ※ シート1の内容は日毎に更新されますので、更新後、赤枠で囲んだボタンをクリックするとその時点で 中 が入力されているものは中シートのリストへ追加されるようにしたいのです。 以前ここで教えていただいたものを参考に作成してみたの(以下に記載)ですがうまくいきません。 お助けいただけないでしょうか。 宜しくお願い致します。 Sub ボタン中シート_Click() 'Sheet2の挿入位置(C列は結合セルではなく、必ず何か入っている事) nMax2 = Sheets("中シート").Cells(Rows.Count, 3).End(xlUp).Row + 1 With Sheets("sheet1") nMax1 = .Cells(Rows.Count, 9).End(xlUp).Row For i = nMax1 To 2 Step -2 If .Cells(o, 15) = "中" Then .Range(.Cells(o, 1), .Cells(o + 1, 10)).Copy Sheets("中シート").Cells(nMax2, 1).Insert Shift:=xlDown .Range(.Cells(o, 1), .Cells(o + 1, 10)).Delete Shift:=xlUp End If Next i End With End Sub

  • エクセルVBAで行のコピー貼り付けについて

    初心者、勉強中でエクセル2007です。 A1行からK40行までの表があります。 これを下にコピーをしながら増やしていってるのですが、マクロでしようと思い下記のとおり 考えました。 selecion.row.Offset(39, -1).Select ここでオブジェクトが必要ですと出ます。 それからその下の?とを色々ぐぐってみますがどうしてもわかりません。 それと2007ですので65536行ではないのですが、MaxRow = Cells(Rows.Count, 1).End(xlUp).Row だと動かないみたいですので下記としています。 よろしくご教授お願いします。 Sub Gcopy() MaxRow = Range("B65536").End(xlUp).Offset(-39, -1).Select データの入ってる最終行を取得 Selecion.row.Offset(39, -1).Select 選択された行から上に39行移動し選択 ?                    下へ39行まで選択   MaxRow = Range("B65536").End(xlUp).Offset(1, -1) 最終行を取得 ActiveSheet.Paste 貼り付け End Sub

  • excel2003入力したデータを別シートにコピー

    会社でエクセル2003を使っています。 ド素人で、専門用語が全く分からないのでお許しください。 ひな形に入力したデータを その都度、別シートにリストとして保存したいのです。 ネットで調べたところマクロを使うようで Sub 正方形長方形4_Click() Call macro01 Call macro02 End Sub Sub macro01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") x = ws2.Cells(Rows.Count, "b").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "b").End(xlUp).Row ws1.Cells(21, "b").Resize(y, 9).Copy ws2.Cells(x, "B").PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub Sub macro02() Worksheets("Sheet1").PrintOut End Sub いろいろ知らべみてこのようなマクロを作りました。 家のエクセル2010では順番に入力行のその下にデータリストが増えていくのですが 会社の2003だと2行空いてしまうのです。 上記にマクロは家で作って会社ではそのマクロを入力する形です。 マクロの意味が全く分からず、どこを修正すればいいのかもわかりません。 お力をお貸しください。 よろしくお願いいたします。

  • 途中に空白行や列があるデータ範囲

    エクセル2003です。 セルA1からセルC50までデータがあり 10行目と20行目は全て空白、 セルC39が空白で セルE55、F57、G55にはデータがある の状態で以下の構文ですと Sub 範囲コピー1() Range("B3").Select Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select Selection.Copy End Sub 途中に空白行や列、空白セルがあり さらに離れた所E55、F57、G55に データが有るのにもかかわらず セルB3からセルG57までを選択してクリップボードにコピー してくれます。 ですが問題がありまして 上記のシートにて A45~F50を選択してDeleteをし、 さらにセルのF55、G55もDeleteして データ範囲を セルA1~E44とセルE55のみにしてからから 上記構文を実行すると セルB3からセルE55を選択してクリップボードにコピー してほしいのに、 データ削除前と同様の セルB3からセルG57を選択してクリップボードにコピー されてしまいます。 これはエクセルの手操作 Ctrl+Shift+End でも同じようになりますので当然の結果(※1)と思っています。 (※1→なにか別な方法はありますか?) 上記の使用方法はあまりないのですが 構文を使う時点での最大行数や最大列数は常に不明で 途中空白が有る場合無い場合、 上記のようにシート上でデータ操作をした直後であっても データ削除部分は加味しデータのある範囲だけの取得の対応 が可能な構文を1種類で作成したいのですが どういう方法があるでしょうか? ちなみに Sub 範囲コピー2() Range("B3").Select Range(Cells(Rows.Count, 1).End(xlUp).Row).Select Range(Cells(1, Columns.Count).End(xlToLeft).Column).Select Selection.Copy End Sub これですと 実行時エラー1004 Rangeメソッドは失敗しましたGlobalオブジェクト となります。 ヘルプをクリックしても何も表示されません。 WEB検索するとこのエラーの質問は結構多いのですが 事例が相違する為よく理解できません。 もしかしてRangeなのに 取得できる値が一つの番号でセルを指定できないからでしょうか? エラーになる構文だと最初のRangeは行番号、次のRangeは列番号、 ですので。 で、 Sub 範囲コピー3() Dim 最終行 Dim 最終列 Range("B3").Select 最終行 = Cells(Rows.Count, 1).End(xlUp).Row 最終列 = Cells(1, Columns.Count).End(xlToLeft).Column Cells(最終行, 最終列).Select Selection.Copy End Sub これならエラーにはなりませんが 事例だとセルC50だけが単独選択されて範囲として 取得をしてくれません。 また 1, Columns.Count ですので最終列の列番号の取得が1行目の最終列から左に検索し データのある所の列番号を返すので 3→C列 となってしまい D,E,F列を見つけてくれません。 かといって 55, Columns.Count では データが55行まで無い場合には対応が出来ませんのでこれも駄目です。 途中に空白が無い場合や離れたセルが無い場合でも使いたいので UsedRangeは使用したくない(よくわかってない事もあって)です。 よろしくお願いします。

  • フィルタで選択した行を別シートにコピーするマクロ

    よろしくお願いします シート1 の一行目にタイトルがあって 二行目以降にデータ(30列目まで)が 入っております そのデータをオートフィルタで抽出して 抽出されたデータ(タイトル行は不要)を 選択してシート2のデータ最終行の 一行下へ貼り付けたいのですが。 シート1で Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 30)).Select こうやって選択した後の記述がわかりません。 このままシート2の最終行を 選択貼り付けしようとするとシート1の選択内容が 消えてしまう(シート2が最新の選択になるため?) 挿入の際に「下へ」「右へ」など聞かれるのも 面倒なので行選択したいのですが 御教授ねがいます

  • シート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行だけコピーできないでしょうか?

  • 変数を名前に使ったシートにデータをコピーする方法

    いつもお世話になります。 hisworkbookにあるVBAから新たに開いたmyFileにデータをコピーさせようとしています。 myFileである統合.xlsにはあらかじめ該当するシートが作成されています。 myBushoとmyGroupはそれぞれセルの値を参照しています。 それを元に対応するシート名にデータのコピーをしたいのです。 当初workbooks(myFile)をactiveworkbookにしていたのですが、うまくコピーされなかったので、 ファイルパスを記述しました。 sub test() dim cnt as long dim lcnt as long dim myFile as string dim myBusho as string dim myGroup as string cnt = ThisWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row lcnt = ActiveWorkbook.Sheets(myBusho & "_" & myGroup).Cells(Rows.Count, 1).End(xlUp).Row myFile = "C:\統合.xls" myBusho = range("A1").value myGroup = range("A2").value ThisWorkbook.Sheets("Sheet1").Range(Cells(9, 1), Cells(cnt, 21)).Copy _ Workbooks(myFile).Sheet(myBusho & "_" & myGroup).Cells(lcnt + 1, 1) end sub 上記のコードではうまくコピーできませんでした。 よろしくアドバイスのほど、お願いします。

  • Excel007大量データのコピーが

    (1)、Sheet1の("Y7:MV7")の各セルに値A、B、C、の何れかが配置形の中央揃えで入ってます。 (2)、Sheet2の("O3:ML3")の各セルには1~336の数字が順に振られています。 そして(1)の形でデータが入るたびに(2)の最下に(1)の値だけがコピーされるようにVBAで次の様に書いてみました。 Sub test() Worksheets("Sheet2").Select Dim n As Byte, t As Byte n = Cells(Rows.Count, "O").E nd(xlup).Row + 1 t = Cells(Rows.Count, "ML"). End(xlup).Row + 1 Range("O" & n:"ML" & t).Sele ct Selection = Worksheets("Shee t1").Range("Y7:MV7").Value End Sub が、オーバーフローのエラーになります。 間違いの原因やお奨めなど頂けたらありがたいです。

専門家に質問してみよう