複数シートから一覧を作成VBAについて

質問

VBA超初心者です。
仕事でアンケート集計をしているのですが、効率よくするために質問させてください。

1つのブックに50程のシートがあり、1行目には1～30の設問Noがあり、2行目以降に回答（1～5の数字）が縦に並んでいます。
回答者数は最大で150名です。

アンケート集計として、152行目に回答が”1”の個数、153行目に”2”の個数といった感じで、156行目まで回答1～5の個数が並んでいます。
その次の157行目に平均値が入力されています。

集計用のシートを作成し、そのシートの2行目以降に、各シートの平均値（157行目）を縦に一覧として並べたいのですが、各シートをコピペしていくのは大変なので、VBAで何とかできないかと、いろいろなサイトを参考にやっているのですが、なかなかうまくできず、困っています。

どなたかご教授願えませんでしょうか。
よろしくお願いいたします。

回答No.5

keithin · ベストアンサー

ご質問の直接の回答としてはこんなカンジで十分です。

タイトル行を準備した集計用シートを開いて実行する：
sub macro1()
　dim w as worksheet
　for each w in worksheets
　　if w.name <> activesheet.name then
　　　range("A1:AD1").offset(range("A65536").end(xlup).row).value = w.range("A157:AD157").value
　　end if
　next
end sub

＃具体的に何列から何列の表になってるのか情報提供がありませんので、ご自分で適切に修正してご利用ください。

ただし、実際にはご質問でやろうとしてるのでは色々使い難くて、もうちょっと工夫したほうがよさそうです。

準備：
１枚目から５０枚のデータシートのＡ列には空列を挿入しておく
集計シートのＡ列も空列にしておく
集計シートの１行目（Ｂ列から）にはタイトル行を用意しておく

sub macro2()
　dim w as worksheet
　for each w in worksheets
　　if w.name <> activesheet.name then
　　　with range("A65536").end(xlup).offset(1)
　　　　.value = w.name
　　　　.offset(0, 1).resize(1, 30).formula = "=INDIRECT(RC1&""!R157C"",FALSE)"
　　　end with
　　end if
　next
end sub

実際にはマクロを使うのは（不定の）シート名一覧を列記させるだけで、手で数式を準備しておけば十分です。

お礼

多くの方にご回答いただきありがとうございました。

様々なやりかたがあるものだと、非常に勉強になりました。

結果としまして、一つのマクロで簡単にできるkeithinさんの回答をBAとさせていただきました。

みなさまありがとうございました。

回答No.4

tom04

こんばんは！
すでに回答は出ていますので、余計なお世話かもしれませんが・・・

「集計用」Sheetがない場合は「集計用」（Sheet名）を追加して
「集計用」SheetのA列に各SheetのSheet名を、B列以降に各SheetのA157～AD157の値を表示するようにしてみました。
標準モジュールです。

Sub Sample1()
Dim k As Long, cnt As Long, myFlg As Boolean

'▼「集計用」SheetがなければSheet見出しの一番左に「集計用」Sheetを追加
For k = 1 To Worksheets.Count
If Worksheets(k).Name = "集計用" Then
myFlg = True
Exit For
End If
Next k
If myFlg = False Then
Worksheets.Add before:=Worksheets(1)
ActiveSheet.Name = "集計用"
End If

'▼「集計用」SheetのA2以降に各Sheet名を、B列以降に各SheetのA157～AD157セルの値を表示
cnt = 1
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> "集計用" Then
cnt = cnt + 1
With Worksheets("集計用").Cells(cnt, "A")
.Value = Worksheets(k).Name
.Offset(, 1).Resize(, 30).Value = Worksheets(k).Cells(157, "A").Resize(, 30).Value
End With
End If
Next k
End Sub

こんな感じではどうでしょうか？m(_ _)m

回答No.3

weboner

>シート名は各アンケートを実施した地名（神戸・大阪等）になっています。

ですか、マクロでの回答もすでに出ていますが
一応関数での対処法も

http://www.tipsfound.com/Excel2010/01306.vbhtml
↑
このサイトの名前定義の部分を参考に
名前に「book」を入力し、参照範囲に=GET.WORKBOOK(1)を入力して「OK」

そうすると
前回提示した計算式を一部変更して
=INDIRECT(INDEX(book,ROW(1))&"!R157C"&COLUMN(),0)

これで取得できます

回答No.2

High_Score

集計シート名は　Sheet1　として、ブックの一番左にあるとします。その右側以降に各地区のシートが並ぶとします。

Sub Macro2()
Dim WS1 As Worksheet
Set WS1 = Worksheets("Sheet1")

With WS1
For i = 1 To 30
.Cells(i + 1, 1).Value = i
Next i
For i = 2 To Worksheets.Count
.Cells(1, i).Value = Worksheets(i).Name
For j = 1 To 30
.Cells(j + 1, i).Value = Worksheets(i).Cells(157, j).Value
Next j
Next i
End With
End Sub

回答No.1

weboner

シート名がSheet1～Sheet50になっているのであれば
VBA使わなくても

集計用のシートA2セルに
=INDIRECT("Sheet"&ROW(A1)&"!R157C"&COLUMN(),0)

後は↓→とドラッグして必要な分だけコピー
このままでは横方向の並びなので、範囲をコピーして縦横変更で値のみ貼り付ければいい

シート名が番号一覧でなければ他の方法が必要にはなるけど

補足

weboner　様

ご回答ありがとうございます。
説明不足でした。
シート名は各アンケートを実施した地名（神戸・大阪等）になっています。