マクロでシートをまとめる

質問

ＥＸＣＥＬ９７で２００枚くらいのシートのデータを1つのシートにまとめようと思っています。
例えばＥ２～Ｚ２のデータ（ほかのセルにも計算の参照をしているデータあり）だけを１枚のシートに上から下に順番に並べていきたいと思っています。
この場合値コピーをするか元のシートのデータを計算の参照にしないといけないと思いますがそれはどちらでもいいです。この場合マクロでどうプログラムを組めばいいでしょうか？

回答No.2

ja7awu · ベストアンサー

次のマクロを実行すると、3行目で指定したシート名のシートを一番左に
追加作成し、各シートの2行目で指定した範囲の値を順に集めます。
指定したシート名が、既に存在する場合は、そのシートを一番左に移動し、
現データで書き換えます。

集めた側のシートの配置が、書かれていませんので、一応、A1からにしています。

Sub GetAllShData()
'-------- 設定事項 ---------
Const GetHani = "E2:Z2" ' <--- 各シートのコピー範囲（1行）
Const PutShName = "まとめ" '<--- 集めるシート名を指定
'---------------------------
Dim N As Integer
For N = 1 To Worksheets.Count
　　If Worksheets(N).Name = PutShName Then Exit For
Next N
If N > Worksheets.Count Then
　　Worksheets.Add Before:=Sheets(1)
　　Worksheets(1).Name = PutShName
Else
　　Worksheets(N).Move Before:=Worksheets(1)
　　Worksheets(1).Cells.Delete
End If
For N = 2 To Worksheets.Count
　　Worksheets(N).Range("E2:Z2").Copy
　　Worksheets(1).Select
　　Range("A" & N - 1).Select
　　Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
　　　　SkipBlanks:=False, Transpose:=False
Next N
Application.CutCopyMode = False
End Sub

お礼

ありがとうございます。
家でのテストデータでは問題なくできました。

回答No.3

papayuka

コピー＆ペーストを使わない方法で書いてみました。
書式設定も持ってくる必要がある場合は向きません。

集計したいシート200枚は同一ブック内にあるという前提です。
先頭にシートを追加して纏めます。
Resize(1, 22) の 22 は E列から22列目(Z列)までの意味です。
試すならテスト環境で。

Sub Test()
Dim ws As Worksheet, i As Integer, cnt As Long
With ThisWorkbook
　Set ws = Worksheets.Add(before:=.Worksheets(1))
　cnt = 2
　For i = 2 To .Worksheets.Count
　　ws.Range("E" & cnt).Resize(1, 22) = _
　　.Worksheets(i).Range("E2").Resize(1, 22).Value
　　cnt = cnt + 1
　Next i
End With
End Sub

お礼

ありがとうございます。
家でのテストデータでは問題なくできました。

回答No.1

imogasi

簡単なテストデータでは上手く行きましたが、「ほかのセルにも計算の参照をしているデータあり」とか「元のシートのデータを計算の参照にしないといけないと」とややこしいことが質問に書いてあるので、自信がありませんが、良ければ２－３シートでテストしてください。
その場合下記でSheet4やSh4は集約するシートのシート名等ですから、実際にあわせて変えること。
また列はC列が各シートを通しての、最右列としていますが
実際は全シートを調べて最右列の記号に置換えてください。
Sub test01()
Dim sh As Worksheet
Dim sh4 As Worksheet
Set sh4 = Worksheets("sheet4")
s = 1
For Each sh In Worksheets
If sh.Name = "Sheet4" Then
' MsgBox sh.Name
Else
sh.Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
d = Selection.Row
sh.Range(sh.Cells(1, "A"), sh.Cells(d, "c")).Copy
Sheets("Sheet4").Select
sh4.Cells(s, "A").Select
ActiveSheet.Paste
s = s + d
End If
Next
End Sub
また（集約）累積される順番はシートタブの見えている
左からの順番になリます。実行の前に都合の良いように並べておいて下さい。

お礼

ありがとうございます。
火曜日に会社に行かなければ分からないですが、
家でのテストデータでは問題なくできました。