|
|
| Excel VBA Macro ・ コピー ・ FAQ |
|
複数シートのデータを順繰りに貼り付けるには？
|
|
|
|
Question 83.5 |
Excel VBA Borad （掲示板）より |
 |
 |
|
|
はじめまして、マクロ初心者です。
仕事の書類でエクセルの自動化で効率化したいのですが、以下のようなことをマクロで組みたいと思っています。
複数シートごとにオートフィルターで抽出したデータをある一つシートにまとめて表示させたいのですが、どのようなマクロを組めばよいのでしょうか。
一つのシートからのフィルター抽出、コピー、別シートへの貼り付けは、本などをみてマクロがわかりました。(下記)
Sub データ抽出1()
Sheets("松下商品A").Select
Selection.AutoFilter Field:=1, Criteria1:="■"
Selection.CurrentRegion.Copy
Worksheets("回答").Select
Range("A18").PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
End Sub
わからないところは、複数のシートから抽出したデータを集めて、回答シートへ貼り付ける部分です。
表のフォーマットが同じ10個のシートから抽出データをコピーしてきたいのですが、抽出データの数は都度違うため、回答シートへの貼り付け時のセル指定のマクロをどうすればいいのかわかりません。
上記のマクロですと回答シートのA18セルからの貼り付けを指定していますので、集めてきた抽出データが上書きされることなく、順繰りにペーストできるようにしたいのですが、
よろしくお願いします。
|
|
|
初心者さんということですが、十分理解力のある方とお見受けします。
Worksheets("回答").Select
Range("A18").PasteSpecial Paste:=xlPasteAll を下記のように書き換えて実行してみてください。下2行はおまけです。
行 = 18
Worksheets("回答").Select
Range("A" & 行).PasteSpecial Paste:=xlPasteAll
行 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
MsgBox 行
すると、同じように貼り付けられて、メッセージボックスに「順繰りにペースト」するための行が表示されます。そして、成功したら、マクロを次のように修正します。
Sub データ抽出1()
行 = 18
For I = 1 To 10
Sheets("松下商品A").Select
Selection.AutoFilter Field:=1, Criteria1:="■"
Selection.CurrentRegion.Copy
Worksheets("回答").Select
Range("A" & 行).PasteSpecial Paste:=xlPasteAll
行 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
Next
Application.CutCopyMode = False
End Sub
すると、「松下商品A」シートのフィルタ結果が「回答」シートに「上書きされることなく、順繰りにペースト」されます。
あとは、For...Next文のループ中、「フォーマットが同じ10個のシート名」を順に指定する仕組みを考えれば完成します。
ガンバって考えても分からなかった時には、書き込みされれば・・・
サンプルブックのダウンロードは ここをクリック
（YNxv9887_Pivot.lzh 18KB）
※ 一旦、ハードディスクに保存し、解凍してから実行してください。 |
|
|
教えていただいマクロを参考に、別のシートのものを同じように貼り付けようとしたのですが、うまくいきません。
for next文中の、別シートを順に指定していく仕方がわかりません。
Sub データ抽出1()
行 = 18
For I = 1 To 10
Sheets("松下商品A").Select
Selection.AutoFilter Field:=1, Criteria1:="■"
Selection.CurrentRegion.Copy
Worksheets("回答").Select
Range("A" & 行).PasteSpecial Paste:=xlPasteAll
行 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
Sheets("松下商品B").Select
Selection.AutoFilter Field:=1, Criteria1:="■"
Selection.CurrentRegion.Copy
Worksheets("回答").Select
Range("A" & 行).PasteSpecial Paste:=xlPasteAll
行 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
Next
Application.CutCopyMode = False
End Sub
上のマクロ文のようにこのfor〜next文の中を単純にシート名を変えて増やしても、A18セルには、松下商品Aの部分しかペーストされず、松下商品Bはその下にペースとされませんでした。
なぜか、ずっと下のセルに連続して表示されるのですが、
行き詰っております。よろしくお願いいたします。
|
|
|
シート名を順に指定する仕組みは、いろいろ考えられますが下記は一例です。(16行目はついでに追加)
Sub データ抽出1()
Dim シート名(10)
シート名(1) = "松下商品A"
シート名(2) = "松下商品B"
シート名(3) = "松下商品C"
シート名(4) = "松下商品D"
シート名(5) = "松下商品E"
シート名(6) = "松下商品F"
シート名(7) = "松下商品G"
シート名(8) = "松下商品H"
シート名(9) = "松下商品i"
シート名(10) = "松下商品j"
行 = 18
For I = 1 To 10
Sheets(シート名(I)).Select
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:="■"
Selection.CurrentRegion.Copy
Worksheets("回答").Select
Range("A" & 行).PasteSpecial Paste:=xlPasteAll
行 = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Row
Next
Application.CutCopyMode = False
End Sub
|
|
|
|
longさん、ありがとうございました。
なるほど、こういう風に定義すればいいのかと、勉強になりました。
|
|
|
|
|
