複数シートの特定セルを１シートにまとめるには？

質問

・・・Ｅ　　　　
５　　名称
・
・
７　　住所
１０　担当者
・
・
のような形式で顧客シートとして複数シート存在してます。

シート名称は、手動で名称に併せて変更してしまっています。
今後もシートコピーで増えていく予定です。

このシートたちを「まとめ」のシートにまとめたいのですが
（シート名は仮にＡから始まるとし）

　　Ａ　　　　　　Ｂ　　　　　　Ｃ　　　　　　　　
１　シートAの名称　　シートAの住所　　シートAの担当者　・・・・・
２　シートBの名称　　シートBの住所　　シートBの担当者　・・・・・
３　シートCの名称　　シートCの住所　　シートCの担当者　・・・・・

こんな感じです。

ヨコ1列にまとめたいのです。
まとめたい項目は元の顧客シートで規則性をもったセルに
入力されている訳ではありませんが、7項目くらいで増える事はありません。
なので、元のセル番号を指定してまとめのシートに
貼付けをするイメージを持っているのですが、
過去のものではこの部分がわからず・・
他のところからみつけたのでは

r.Value = .Range("E5").Value
r.Offset(, 1).Value = .Range("E7").Value
r.Offset(, 2).Value = .Range("E10").Value

がこの部分に値するのかと思いましたが、
そうするとその前後が分からなくなってしまい・・

説明が下手ですいません。
まとめ方を教えてください。

回答No.1

hallo-2007 · ベストアンサー

以下のVBA試してみてください。
一番手前に空白のシートがあるとして

Sub Macro1()
Dim i As Integer
For i = 2 To Worksheets.Count
Cells(i, 2) = Sheets(i).Range("E5").Value
Cells(i, 3) = Sheets(i).Range("E7").Value
Cells(i, 4) = Sheets(i).Range("E10").Value
Next
End Sub

お礼

シンプルなのに、
これで対応していけそうですね、
どうもありがとう御座いました。

回答No.2

fujillin

見つけられたものと同じ形式になるようにして、前後を追加しました。
以下のマクロのうち「まとめ用のシート名」を修正してください。
途中の「・・・・」以下に担当者他のコピーする項目を追加してください。
----------------------------------
Sub test()
Dim sh As Worksheet, r As Range
Const sName = "Matome"　　　　　　　　　　　'←まとめ用シートの名
　Worksheets(sName).Cells.ClearContents　　'←まとめ用シートをクリア
　Set r = Worksheets(sName).Range("A1")　　'←まとめ用シートの記入開始位置

　For Each sh In Worksheets
　　If (sh.Name <> sName) Then
　　　With sh
　　　　r.Value = .Name
　　　　r.Offset(, 1).Value = .Range("E7").Value
　　　　r.Offset(, 2).Value = .Range("E10").Value
　　　　　　'・・・・・・・・・・　ここにコピーしたいセルを追加する
　　　End With
　　End If
　　Set r = r.Offset(1, 0)
　Next
End Sub

お礼

ありがとう御座います。
初心者の私でも対応できるようになっていてとても助かりました！！