Excelマクロで複数の範囲をまとめる方法

前へ 次へ
このQ&Aのポイント
  • Excelのマクロを使用して複数のシートの特定の範囲をまとめる方法について説明します。
  • まず、特定の範囲をコピーして結合する方法を使用します。
  • その後、空白のセルを削除する方法についても説明します。
回答を見る
  • ベストアンサー

エクセルのマクロについての質問です。

データをまとめるためのシートを追加し、 一つのブックにある全てのシートのBX6～CG15の範囲をＡ1を起点に下方向にコピー、 同様に同じブックにある全てのシートのC59～M68の範囲をＫ1を起点に下方向にコピーするというものを組んでみたのですが、C59～M68の範囲をまとめたものには範囲内の空白のセルも入っていますが、BX6～CG15の範囲をまとめたものは空白のセルが消えてしまいます。 この処理のあとに、Ａ列が空白の行を削除するというものを入れたいので、できればどちらの範囲とも空白を入れたまままとめたいのです。 この空白のセルを消さずにまとめる方法がわかりません。 色々と調べて試していますがうまくいきません。 どこを修整するといいのでしょうか？ 超初心者でコードの内容がまだまだわかっていません。 簡単な質問かもしれませんがご教示お願いします。 Sub Macro1() Dim sno As Integer Dim I As Integer sno = Worksheets().Count Sheets(1).Select Sheets.Add For I = 2 To sno + 1 Sheets(I).Range("BX6:CG15").Copy Sheets(1).Range("A65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Next For I = 2 To sno + 1 Sheets(I).Range("C59:M68").Copy Sheets(1).Range("L65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Next End Sub

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

  • ベストアンサー
  • MackyNo1
  • ベストアンサー率53% (1521/2850)
回答No.1

>この処理のあとに、Ａ列が空白の行を削除するというものを入れたいので、できればどちらの範囲とも空白を入れたまままとめたいのです。 提示されているコードがご希望の空白行を削除した（詰めて表示する）コードになっているようですが、わざわざ空白行をそのまま入れたいということでしょうか？ 目的がよくわかりませんが、A1セル以下に１０行ごとにデータを貼り付けたいなら、以下のようなコードに編集することになります。 Sheets(1).Range("A" & (I - 2) * 10 + 1).Select

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • エクセルのマクロについての質問です。

    エクセルのマクロについての質問です。 複数のシートのデータを一つのシートにまとめるマクロを使用しています。 以下のものになります。 Sub まとめ() Dim i As Long, ii As Long ii = 1 With Worksheets .Add before:=.Item(1) For i = 2 To .Count .Item(i).Range("BX6:CQ15").Copy .Item(1).Cells(ii, "A") .Item(i).Range("C59:U68").Copy .Item(1).Cells(ii, "U").PasteSpecial Paste:=xlPasteValues ii = ii + 10 Next i End With Application.CutCopyMode = False Range("1:1").Insert Sheets(2).Range("BX5:CQ5").Copy Sheets(1).Range("A1") Sheets(2).Range("C58:U58").Copy Sheets(1).Range("U1") Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Sheets(1).Columns("C:D").Delete Sheets(1).Columns("F:G").Delete Sheets(1).Columns("G:O").Delete End Sub このマクロを使用してまとめたシートの数値の部分（各シートのC59:U68のデータを貼り付けた部分、まとめたシートのH2のセルが起点です）を変更するとコピー元（各シートのC59:U68）の数値も同じように変わるというものを作りたいです。 いろいろと調べましたが手も足も出ませんでした。 ご教示いただけないでしょうか？ 宜しくお願いいたします。

  • エクセル２００７マクロ　シート間のセルコピー

    [Sheet1]にあるデータを[Sheet2]にコピーするマクロボタンを[Sheet2]に作りたいのですが、マクロがよく分からないので、「マクロの記録」で作成してみました。 Sub siken() ' ' siken Macro ' ' Sheets("Sheet1").Select Range("A1").Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Sheets("Sheet1").Select Range("B3").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B3").Select ActiveSheet.Paste Sheets("Sheet1").Select Range("B6:D6").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B6").Select ActiveSheet.Paste End Sub （実際はもっと多くのセルをコピーします） マクロを実行すると、ちゃんとコピーできるのですが、セルをコピーする都度[Sheet1]と[Sheet2]が交互に表示されます。 コピー元の[Sheet1]を表示させずにマクロを実行させるにはどのようにしたらよいのでしょうか？ よろしくお願いします。

  • Excel VBA　範囲の条件付け

    現在下記のコードを組んでいます。 やりたい事は、sheet１～３で背景色の赤いセルと、 そのセルの上方の最初の空白セルの下３行をsheet4にコピペする。 【下記コードで実現出来ていないこと】 １．背景色が赤いセルとそのスグ上の３行をコピペしてしまう。 ２．同じシートに背景色が赤いセルが複数あっても、１つしかコピペしない。 ３．sheet4のコピペ先をA3、A13、A23と仮に指定しているが、 　sheet1のコピペ内容に１行空けて、sheet2のコピペ内容、 　また１行空けて、sheet3のコピペ内容というセル指定にしたい。 以上、よろしくお願い致します。 Sub Test() Dim i As Long, r As Range With Worksheets("sheet1") For i = 1 To .Range("A65536").End(xlUp).Row If .Range("A" & i).Interior.ColorIndex = 3 Then Set r = .Range("A" & i).EntireRow Set r = Union(r, r.End(xlUp).Resize(3).EntireRow) End If Next i End With If Not r Is Nothing Then r.Copy Sheets("Sheet4").Select Range("A3").Select ActiveSheet.Paste With Worksheets("sheet2") For i = 1 To .Range("A65536").End(xlUp).Row If .Range("A" & i).Interior.ColorIndex = 3 Then Set r = .Range("A" & i).EntireRow Set r = Union(r, r.End(xlUp).Resize(3).EntireRow) End If Next i End With If Not r Is Nothing Then r.Copy Sheets("Sheet4").Select Range("A13").Select ActiveSheet.Paste With Worksheets("Sheet3") For i = 1 To .Range("A65536").End(xlUp).Row If .Range("A" & i).Interior.ColorIndex = 3 Then Set r = .Range("A" & i).EntireRow Set r = Union(r, r.End(xlUp).Resize(3).EntireRow) End If Next i End With If Not r Is Nothing Then r.Copy Sheets("sheet4").Select Range("A23").Select ActiveSheet.Paste End Sub

  • エクセルVBAについての質問です。

    エクセルＶＢＡについての質問です。 　動作環境は 　OS:WINDOWS XP 　エクセル２００３　　です。 今、Book1.xlsというエクセルファイルがあります。 このファイルの中に、【sheet1】,【sheet2】,【sheet3】の３つのシートが存在しています。 【sheet1】および【sheet2】には、Ａ列＝ユニーク番号、Ｂ列＝データ１、Ｃ列＝データ２・・・・ｎ列＝データｎの値が約1500行（各行で、データの値は異なります。）入っています。 この【sheet1】と【sheet2】のデータの内容を照合して【sheet3】にその結果を反映（TRUEまたはFALSE）します。 仮に【sheet3】のあるセル（仮にD3）の値がTRUEとなったら、【sheet1】のセル（D3）の値を【sheet3】のセル（D3)に代入する。 逆に【sheet3】のあるセルの値がFALSEとなったら、そのセルはFLASEのままにする。プログラムは以下の様にしたのですが、全てを処理するまでに相当時間がかかっています。 VBAのプログラムは今回初めて書いたので、プログラムが悪いのか、プログラムの思想が悪いのかがわかりません。 どなたかご教授していただけませんか？多分、コードの書き方もキレイではないと思います（悲） Private Sub データ照合ボタン_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim i As Long Dim area As Range Dim A As Variant Dim WrkRange As String '----シート（１）とシート（２）の各セルの値を比較---- With Sheets("sheet1") WrkRow = .Cells(Rows.Count, 3).End(xlUp).Row End With Sheets("sheet3").Select For i = 12 To WrkRow WrkRange = Range("C" & i).Select ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)" WrkRange = Range("D" & i).Select ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)" '・ 　　　　　　　　　　'・ 　　　　　　　　　　'・ Next i A = i - 1 Sheets("sheet1").Select For i = 12 To A WrkRange = Range("C" & i).Select Selection.Copy Range("C" & i).PasteSpecial xlPasteValues Sheets("sheet3").Select If Range("C" & i) = True Then Sheets("sheet1").Select Range("C" & i).Copy Sheets("sheet3").Select Range("C" & i).Select ActiveSheet.Paste Else: End If Next i A = i - 1 Sheets("sheet1").Select For i = 12 To A WrkRange = Range("D" & i).Select Selection.Copy Range("D" & i).PasteSpecial xlPasteValues Sheets("sheet3").Select If Range("D" & i) = True Then Sheets("sheet1").Select Range("D" & i).Copy Sheets("sheet3").Select Range("D" & i).Select ActiveSheet.Paste Else: End If Next i 　　　　　　　　　'・ 　　　　　　　　　'・ 　　　　　　　　　'・　　　 End Sub

  • エクセルのマクロでの質問です

    エクセルのマクロでの質問です。 やりたいことは、 明細シートから、「1.3.5」の条件に合うものを実績シートの最終行にコピーして追加していきたいんです。 これだと、実績シートの最終行にはコピーされるんですが 最終行に全部が上書きコピーされる状態になってしまってます。 どう直せば、追加される形になりますか？ Sub コピー() '1,3,5のものを実績にコピーする i = 5 J = Sheets("実績").Cells(Rows.Count, 4).End(xlUp).Row + 1 Sheets("明細").Select Do While Cells(i, 8).Value <> "" If Cells(i, 3).Value = 1 Or Cells(i, 3) = 3 Or Cells(i, 3) = 5 Then Range("D5", "H5").Copy Sheets("実績").Select Range("C" & J).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End If i = i + 1 Loop End Sub まったくのマクロ初心者です。 分かりやすく教えていただけると、助かります。 また、参考になりそうなサイトなどがあったら、教えてください。

  • エクセルのマクロについて

    エクセル97でマクロを組んで下記作業を行いたいと考えていますが（実際にやりたい事から抜粋した内容です）、不具合が起こっています。 ～やりたい事～ コマンドボタンを押すとあるシートのセルをコピーして、違うシートに貼り付ける。 ～不具合内容～ (1)普通にマクロを実行すると問題ないが、(2)コマンドボタンを使用するとエラーが起こる。 エラー内容は、 「実行時エラー'1004' RangeクラスのSelectメソッドが失敗しました。」 と言う内容です。 ～(1)のVB表記～ Sub Macro1() Sheets("sheet1").Select Range("A1").Select Selection.Copy Sheets("sheet2").Select Range("A1").Select ActiveSheet.Paste End Sub ～(2)のVB表記～ Private Sub CommandButton1_Click() Sheets("sheet1").Select Range("A1").Select　（←ここでエラーが発生します） Selection.Copy　 Sheets("sheet2").Select Range("A1").Select ActiveSheet.Paste End Sub ～質問事項～ 1）(2)の表記の何が原因でエラーが起こっているのでしょうか？ 2)エラーが起きない為にはどのようにしたら良いでしょうか？

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの（氏名や項目は違いますが）を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1（A9) →　sheet2(C2) sheet1（E9) →　sheet2(C5) sheet1（I9) →　sheet2(C8) ●項目1 sheet1（A8) →　sheet2(E3) sheet1（E8) →　sheet2(E6) sheet1（I8) →　sheet2(E9) ●項目2 sheet1（A18～D18の結合セル) →　sheet2(E2) sheet1（E18～H18の結合セル) →　sheet2(E5) sheet1（I18～L18の結合セル) →　sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか？？ ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • Excel　繰り返しマクロ

    下記のようなマクロを使ってn個あるシートの内容を「集計」シートにコピーさせるようにしました。 (自動マクロとの組合せなので、スマートではないかもしれませんが) でも、これだと「集計」シートもコピー作業を行ってしまうので、 「集計」シートはコピー作業をしないように除外したいのですが、どうしたら良いのでしょう? 実際にはシート数は30程度、コピペ項目は1シートあたり30項目程度あります。 よろしくお願いします。 ------------------------- Sub テスト2() ' For i = 1 To Worksheets.Count '案件番号等コピー ' Sheets(i).Select Range("D3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '案件名 Sheets(i).Select Range("F3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '国名 Sheets(i).Select Range("E3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '選択セルの解放 Application.CutCopyMode = False '行挿入 ' Sheets("集計").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Next i End Sub

  • マクロを使ったコピペがうまく動作しない。

    あるデータを転記用のブック（月毎にシートが分かれています。シートの内容は同一）に貼り付ける処理を行うため、下記のようなマクロを組んだのですが、何故か貼りつきません。処理終了時には、転記元ブック（シート）で最終処理の範囲（５番目のB287）を選択しています。一体何がいけないのでしょうか？ データはA1からPまでで毎月可変しています。 また、転記用ブックが12枚あるため、月を指定してから貼り付けたいのですが、どのようにすればよいでしょうか？（下記は直接シ－トを指定しました） Sub test() Dim 最終行 As Integer '-------------------------------------------- 開始 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("1").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B1").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 1 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("2").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B83").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 2 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("3").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B157").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 3 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("4").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B227").PasteSpecial Paste:=xlPasteValues '-------------------------------------------- 4 Windows("21-12.xls").Activate 最終行 = Range("p65536").End(xlUp).Row Sheets("5").Range("A1:p" & 最終行).Select Selection.Copy Windows("転記.xls").Activate Sheets(12月).Select Range("B287").PasteSpecial Paste:=xlPasteValues --------------------------------------------- 5 End　Sub　

  • エクセルをバージョンアップさせたらマクロがうまくいきません

    OSはXPです エクセル2002から　2003にバージョンをあげました いままでうまくいっていたマクロが Range(Cells(1, 1), Cells(Cells(65535, 1).End(xlUp).Row, 9)).Select Selection.Copy Sheets("Sheet1").Select Sheets.Add ActiveSheet.Paste このような内容で ActiveSheet.Paste　　この部分でエラーが起きます 「実行時エラー　”1004” 　worksheetクラスのpasteメソッドが　 　失敗しました」 というメッセージがでます。 どういう対処をしたらよろしいでしょうか？ ご教授ください。 （バージョンを元にに戻すなど）

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する