• ベストアンサー

マクロを利用して各シートのデータを一枚のシートへコピーペーストする方法

エクセルのマクロを利用して各シートのデータを一枚にまとめたいと考えています。 方法がわかる方いらっしゃいましたら教えてください。 1.【Sheet1からSheet19】のデータをシート【Sheet0】にコピーし一枚にしたい。  Sheet20以降はコピーしない。 2.【Sheet1からSheet19】の行【12】と【Sheet0】の行【14】には同じタイトルが入っています。  【Sheet1からSheet19】のタイトル列を参照して【Sheet0】の同じタイトル列にコピーしたい。 3.コピーしたい行は【Sheet1からSheet19の15】行目から以下になります。  【Sheet0の17】行目以降にコピーするようにしたい。 4.【Sheet1】のコピーが終わったら【Sheet1】の最後の行に  【Sheet2】からコピーを開始するような形にしたい。以下【Sheet19】まで繰り返す。 以上よろしくお願いします。

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

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.4

> Sheet1~19は必ずしもA列やB列などに同じタイトルの列があるとは限りません。 なるほど・・・。 ではお望みのようにタイトルが一致するかどうかマッチングしてみましょう。 Sub test01() Dim i, a, b, ar, ac, br, bc, z, p, n, m For i = 1 To 19 a = Sheets("Sheet" & i).UsedRange.Cells.Count ar = Sheets("Sheet" & i).UsedRange.Cells(a).Row ac = Sheets("Sheet" & i).UsedRange.Cells(a).Column b = Sheets("Sheet0").UsedRange.Cells.Count br = Sheets("Sheet0").UsedRange.Cells(b).Row bc = Sheets("Sheet0").UsedRange.Cells(b).Column For m = 1 To bc For n = 1 To ac If Sheets("Sheet" & i).Cells(12, n) = Sheets("Sheet0").Cells(14, m) Then z = Application.Max(Sheets("Sheet0").Cells(Rows.Count, m).End(xlUp).Row + 1, 17) For p = 15 To ar Sheets("Sheet0").Cells(z + p - 15, m).Select Sheets("Sheet0").Cells(z + p - 15, m) = Sheets("Sheet" & i).Cells(p, n) Next p End If Next n Next m Next i End Sub

aisu_san3
質問者

お礼

いつも回答ありがとうございます。 すごいです!間違いなく、はき出されました。本当に助かります。 ですが、行が元のデータからズレて配置になってしまいます。 私がまた書かなかったので申し訳ないです。 結果としてあと少しで、おもったような出力になるのですが Sheet1~19の列は必ずしも一致しないが Sheet1等の元の行がずれないようにSheet0へ出力されるようにしたいです。 つまり、例をあげればSheet1の20行の出力はSheet0のある行へずれないように吐き出し、列は今回の通りに吐き出されれば、おもった出力になります。 もし可能であれば教えてください。 本日は、これ以上パソコンの前にいることが出来ないので後日 連絡となってしまいますがご了承ください。

その他の回答 (4)

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.5

> Sheet1等の元の行がずれないようにSheet0へ出力されるようにしたいです。 意味がよくわかりません。 質問では、 > 3.コピーしたい行は【Sheet1からSheet19の15】行目から以下になります。 > 【Sheet0の17】行目以降にコピーするようにしたい。 > 4.【Sheet1】のコピーが終わったら【Sheet1】の最後の行に > 【Sheet2】からコピーを開始するような形にしたい。 となっており、そのようにしたつもりでしたが、どうずれたのですか?

aisu_san3
質問者

お礼

いつもありがとうございます。 どうにか自力で無事に結果がうまく吐き出されるようになりました。 merlionXXさんから意見をいただけなかったら完成しなかったとおもいます。 本当にどうもありがとうございました。 また何かありましたらよろしくお願いいたします。

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.3

#1です。 > ずれないように【Sheet1からSheet19】のタイトル列を参照して > 【Sheet0】の同じタイトル列にコピーしたいのです。 Sheet1~19は同一の列配置であり、データを集約するのはSheet0という特定のシートなんですよね? それなのにいちいちタイトル名で無駄にマッチングをさせようというのですか? Sheet0の列配置をSheet1~19の列配置と同一にしたらいかがでしょう? それが無理なら、マッチングではなく、Sheet1~19のどの列がSheet0のどの列に対応するのか、aisu_san3さんが最初からちゃんとお書きいただいていれば対応出来たと思うのですが・・・・

aisu_san3
質問者

お礼

お返事ありがとうございます。 私の書き方が悪く大変ご迷惑をおかけいたします。 >Sheet1~19は同一の列配置 Sheet1~19は必ずしもA列やB列などに同じタイトルの列があるとは限りません。 しかし、Sheet1~19には同じタイトルの列が存在し、それを一まとめにしたいのです。 >データを集約するのはSheet0という特定のシートなんですよね? はい、そうです。Sheet0にはSheet1~19のすべてのタイトルが入り そのタイトルの場所にそれぞれバラバラになっているデータをまとめたいのです。 >Sheet0の列配置をSheet1~19の列配置と同一にしたらいかがでしょう? そういわれてみれば確かに・・・。お手数おかけして申し訳ありません。 早速並びを変えて試してみたいとおもいます。

  • imogasi
  • ベストアンサー率27% (4737/17070)
回答No.2

VBAコードを極力簡素にするため、前提が多くなりますが、よろしく。 前提 (1)Sheet1から19まではシートタブを手動で左に寄せて集める。 1-19までのタブの中に、集約しないシートのタブがないように。 またシートタブの順序は、集約後(Sheet0で)の並び順を規定します。 (2)「Sheet0」という名のシートを1-19のタブより右の 方に配置。 (3)見出しは1-19と0は開始行番号が違うだけで、列並びは同じ順だとする。そのように理解した。 ーーー テスト用 Sub test02() For i = 1 To 3 ' MsgBox Sheets(i).Name d = Sheets(i).Range("A65536").End(xlUp).Row ' MsgBox d r = Sheets(i).Range("IV1").End(xlToLeft).Column d0 = Sheets("sheet0").Range("A65536").End(xlUp).Row ' MsgBox d0 Sheets(i).Activate Sheets(i).Range("A13", Cells(d, "C")).Copy Destination:=Sheets("Sheet0").Cells(d0 + 1, "A") Next End Sub -- 要修正 上記で少数簡単例をテストしましたが、本番では下記修正が必要です。 (1)for i=1 to 3-->19にする (2)Cells(d, "C")).CopyのCはデータの最右列の列番号を指定すること。 (3)Destination:=Sheets("Sheet0")のSheet0は如何様にも帰られます。現実にあるシート名なら、何でもOK ーー Sheets(i).Activate  ははずせないようなので注意。てこずった。 r=の部分は使わずに済ましたが、Cells(d, "C")).CopyのCの部分をプログラムで割り出すなら使えるが。

aisu_san3
質問者

お礼

回答ありがとうございます、 早速試してみました。 私の説明の仕方が悪く皆様にご迷惑をおかけしております。 私が行いたかったことはSheet1からSheet19は必ずしもA列やB列に同じ内容があるとは限らないのです。 Sheet0にはすべてのタイトルがあり、そこにSheet1からSheet19のデータをすべて出力したいのです。

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

Sheet1からSheet19の列の配置とSheet0の列の配置が同じであれば、 Sub test01() Dim i, x, y, z, zz For i = 1 To 19 x = Sheets("Sheet" & i).UsedRange.Cells.Count y = Sheets("Sheet" & i).UsedRange.Cells(x).Row z = Sheets("Sheet0").UsedRange.Cells.Count zz = Sheets("Sheet0").UsedRange.Cells(z).Row zz = Application.Max(zz, 16) Sheets("Sheet" & i).Rows("15:" & y).Copy Sheets("Sheet0").Range("A" & zz + 1).PasteSpecial Paste:=xlValues Application.CutCopyMode = False Next End Sub で出来ると思います。

aisu_san3
質問者

補足

回答ありがとうございます。 列が必ずしも一致しないのでズレて配置されてしまいます(><;) ずれないように【Sheet1からSheet19】のタイトル列を参照して 【Sheet0】の同じタイトル列にコピーしたいのです。 もし、わかるようでしたら教えてください。