複数シートのセル値を参照してまとめて一覧表にしたい

質問

100あるシートの最後にまとめとして101のシートを作ります。
その101のシートにはシート1～シート100までのセル値を自動で参照したいのです。

例えばシート1のI6：名前、I10：売上、AQ13：原価、AB40：利益があり、それをシート101のまとめペー1ジの2行目に表示（参照）します。
101まとめページの3行目には同じセル番号のシート2のI6：名前、I10：売上、AQ13：原価、AB40：利益を反映。
101まとめページの4行目にはシート3のI6：名前、I10：売上、AQ13：原価、AB40：利益を反映。
このようにシート1から100までの同じセル番号の各シートのセル値を参照して一覧表にしたいのです。

お分かりにくい説明かもしれなくてすみません。

手作業でまとめシートに各セルに=で参照値をリンクするには大変な作業となりますので、何らかの良い方法があれば教えて頂けますでしょうか？

よろしくお願い致します。

回答No.5

kkkkkm · ベストアンサー

左端からの件はコードを実行すると左端のシートから順にデータが転記されるという事ですので、コードは一か所に記載して大丈夫です。
標準モジュールを作成してそこに記載しておくと、コードを記載したシートを間違って削除してもコードが残るのでその方がいいかもしれません。
セル位置はセルの列と書いた方が良かったですね。

Sub Test()
Dim i As Long, j As Long

j = 2

For i = 1 To Sheets.Count
If Sheets(i).Name <> "一覧" Then
Sheets("一覧").Cells(j, "B").Value = Sheets(i).Range("I6").Value
Sheets("一覧").Cells(j, "C").Value = Sheets(i).Range("I10").Value
Sheets("一覧").Cells(j, "D").Value = Sheets(i).Range("AQ13").Value
Sheets("一覧").Cells(j, "E").Value = Sheets(i).Range("AB40").Value
j = j + 1
End If
Next
End Sub

お礼

お忙しいなか、ご返答ありがとうございます。
記載して頂きましたコードで解決できました！
感謝です。ありがとうございました！

回答No.6

imogasi

既に解答は出ていますが、下記は繰り返しを多用し、プログラムコード行数を減らすことを考えたコードです。
例データ
Sheet1,Sheet2、Sheet3
それぞれのシートのセル　　"A1", "B2", "D5", "F3"に、何かデータを入れる。
その他のセルのデータは何でもよい、使わない。
集約シート　Sheet４　とする
ーーーーー
標準モジュールに
（下記はテスト用のコードが混じっているが本番では省けるコードがあります。
Sub test01()
Application.ScreenUpdating = False 'スピードアップのため画面更新停止
'a = Array("", "I6", "I10", "AQ13", "AB40") '本番での、データを拾う番地
a = Array("", "A1", "B2", "D5", "F3") 'FROM : 各データシートのセル番地　小生のテスト時用
b = Array("", "A", "B", "C", "D") 'TO　:　集約シートでの列位置。ａの配列のセルと対応させる。例Ａ１－－＞Ａ列、Ｂ２－－＞Ｂ列、・・。
Set sh101 = Worksheets("Sheet4") '小生のテスト時用
’本番時には、Set sh101 = Worksheets("ｘｘｘｘ")とｘｘｘｘを実際のシート名に修正してください
sh101.Cells.Clear '集約シートのデータクリア
'--
k = 2 '集約シートデータ開始行指定
For Each sh In Worksheets '当ブックの全シートについて処理繰り返し
If sh.Name = "sheet4" Then '集約シートは除外=集約しない　小生のテスト時用
Else
MsgBox sh.Name 'テスト時確認用。本番では削除。
For c = 1 To 4 '拾うデータが４セルとした場合の例
sh101.Cells(k, b(c)) = sh.Range(a(c))
Next c
k = k + 1 '集約シートで、次回のデータをセットする行のポイント
End If
Next '次のシートの処理へ繰り返し
Application.ScreenUpdating = True
End Sub
ーーーー
結果　Sheet4　A2:D4　小生のテストデータ例　３シートなので３行データになる。
a b cc gg
a1 b1 cc1 gg1
a3 b3 cc3 gg3

お礼

ご丁寧な説明ありがとうございました。
感謝です。

回答No.4

kkkkkm

No.2でシート名一覧をシート101のA列に作成する場合以下のマクロが使えます。

Sub Test2()
Dim i As Long, j As Long

j = 2
For i = 1 To Sheets.Count
If Sheets(i).Name <> "シート101" Then
Sheets("シート101").Cells(j, "A").Value = Sheets(i).Name
j = j + 1
End If
Next

End Sub

回答No.3

kkkkkm

他に、マクロを使わずに左端から順番に取り出す場合
エクセル シート名を取得する
https://www.tipsfound.com/excel/01306
を設定して
I6の場合
=INDIRECT(SUBSTITUTE(INDEX(Book,ROW(1:1)),"[" &doc&"]","")&"!＄I$6")
下にコピー

回答No.2

kkkkkm

あと、シート名を一覧で作成できるのでしたら以下の方法もあります。
他シートと連携に便利なINDIRECT関数の使い方
https://www.forguncy.com/blog/20170905_indirect_sheet

回答No.1

kkkkkm

シート名が質問のように最後の値が連番になっているのでしたら
I6の場合
=INDIRECT("シート" &ROW(1:1) & "!$I$6")
として下にコピーすればできますが

シート名がバラバラでしたらマクロで
(左端のシートから順に転記していきます、シート101は実際のシート名にABCDは実際に転記したいセル位置に変更してください、)
Sub Test()
Dim i As Long, j As Long

j = 2

For i = 1 To Sheets.Count
If Sheets(i).Name <> "シート101" Then
Sheets("シート101").Cells(j, "A").Value = Sheets(i).Range("I6").Value
Sheets("シート101").Cells(j, "B").Value = Sheets(i).Range("I10").Value
Sheets("シート101").Cells(j, "C").Value = Sheets(i).Range("AQ13").Value
Sheets("シート101").Cells(j, "D").Value = Sheets(i).Range("AB40").Value
j = j + 1
End If
Next
End Sub

補足

kkkkkmさま

ご回答ありがとうございます。

実際はシート名はバラバラです。
「左端のシートから順に転記していきます」というのは以下のようなことなのでしょうか？

シート101の実際のシート名は「一覧」です。
よって頂きましたサンプルコードの「シート101」を「一覧」に変えました。
また「A～D」までの記号は「一覧」にて表示したい
その場合一番左端のシートには

------------------------------------------------------
Sub Test()
Dim i As Long, j As Long

j = 2

For i = 1 To Sheets.Count
If Sheets(i).Name <> "一覧" Then
Sheets("一覧").Cells(j, "B2").Value = Sheets(i).Range("I6").Value
Sheets("一覧").Cells(j, "C2").Value = Sheets(i).Range("I10").Value
Sheets("一覧").Cells(j, "D2").Value = Sheets(i).Range("AQ13").Value
Sheets("一覧").Cells(j, "E2").Value = Sheets(i).Range("AB40").Value
j = j + 1
End If
Next
End Sub
------------------------------------------------------

2番目のシートには

------------------------------------------------------
Sub Test()
Dim i As Long, j As Long

j = 2

For i = 1 To Sheets.Count
If Sheets(i).Name <> "一覧" Then
Sheets("一覧").Cells(j, "B3").Value = Sheets(i).Range("I6").Value
Sheets("一覧").Cells(j, "C3").Value = Sheets(i).Range("I10").Value
Sheets("一覧").Cells(j, "D3").Value = Sheets(i).Range("AQ13").Value
Sheets("一覧").Cells(j, "E3").Value = Sheets(i).Range("AB40").Value
j = j + 1
End If
Next
End Sub
------------------------------------------------------

3番目のシートには

------------------------------------------------------
Sub Test()
Dim i As Long, j As Long

j = 2

For i = 1 To Sheets.Count
If Sheets(i).Name <> "一覧" Then
Sheets("一覧").Cells(j, "B4").Value = Sheets(i).Range("I6").Value
Sheets("一覧").Cells(j, "C4").Value = Sheets(i).Range("I10").Value
Sheets("一覧").Cells(j, "D4").Value = Sheets(i).Range("AQ13").Value
Sheets("一覧").Cells(j, "E4").Value = Sheets(i).Range("AB40").Value
j = j + 1
End If
Next
End Sub
------------------------------------------------------

このようにシートの左端からシート100（一覧の直前）までの各シートで（つまり100個のシート）VBの画面を使って一つずつ以下のコードを記載いていくのでしょうか？

もし間違っていたらごめんなさい。

上記のようにやってみましたがうまくいきませんでした。

ご返答頂けましたら幸いです。

よろしくお願い致します。