EXCELで複数シートの集計を別シートに作りたい

いつもお世話になります。
早速ですが、商品毎、担当毎の売上実績表をEXCELで作っています。
以下のようなEXCELシートを各々の担当毎に作成します。
A B C D E F
1 　4月 5月 6月 7月
2 商品○ 合計　 100 97 109 136
3 　A社 　　50 38 27 20
4 　B社 　　13 9 7 3
5 　C社　 8 10 18 33
6 　D社　　20 29 42 58
7 　E社 　　 9 11 15 22
8 商品△ 合計 158 170 119 183
9 　A社 　　13 9 7 3
10 　B社　　33 27 40 38
11 　C社 　　51 55 38 77


Sheet担当A　　※このシート名をSheet名担当A,,,担当Eとします。（Sheet数5）

6枚目のシートを集計用とし、

A B C D E F
1 4月 5月 6月 7月
2 商品○ 合計 308 224 147 159
3 担当A 50 38 27 20　←Sheet担当Aの2列目（C3～F3）
4 担当B 55 40 22 24　 ←Sheet担当Bの2列目（C3～F3）
5 担当C 48 30 30 45　 ←Sheet担当Cの2列目（C３～F３）
6 担当D 67 44 38 26
7 担当E 88 72 30 44
8 商品△ 合計 32 34 28 23　←Sheet担当Aの8列目（C8～F８）
9 担当A 13 9 7 3　 ←Sheet担当Bの8列目（C8～F８）
10 担当B 10 13 9 6
11 担当C 9 12 12 14

としてリンク貼り付けしたく考えています。
リンク貼り付けだと、例えば集計用C3は＝Sheet担当A!C2、C4は＝Sheet担当B!C2とセル設定する必要がありますが、結構大きな集計資料となるので、簡単にリンク貼り付け（例えば、今回は＝Sheet“担当者名”！セル名と担当社名だけ違うので、担当者名だけ一括で変換する）できる方法など内でしょうか？
また、マクロについてはあまり知識がありませんが、簡単に設定できるマクロなどがあれば、教えて頂きたく考えております。
明日、（2/23）朝9時までに資料を完成させなければなりません。
どなたかご教授頂きたく、お願い致します。

※上のEXCEL例が見にくいかと思いますので、画像を添付させて頂きました。

No.1 ベストアンサー 回答者： tom04 回答日時： 2015/02/22 18:01

こんばんは！

Sheet見出しの1番目～5番目に各担当者分のSheetがあり、
6番目のSheetの「合計」行以外に各Sheetの「合計」行を表示するとします。
尚、コード内の「集計」としているSheet名は実際のSheet名にしてください。

標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1() 'この行から
Dim i As Long, k As Long, lastRow As Long, lastCol As Long
Dim c As Range, wS As Worksheet

With Worksheets("集計") '★　「集計」は実際のSheet名に！
Application.ScreenUpdating = False
lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'▼　「集計」SheetのA・B列を作業用の列として挿入（元データは2列ずつ右へずれる）
.Range("A:B").Insert
With Range(.Cells(2, "A"), .Cells(lastRow, "A"))
.Formula = "=IF(C2="""",A1,C2)"
.Offset(, 1).Formula = "=A2&D2"
End With
For k = 1 To 5 'Sheet見出しの1番目～5番目までループ　★
Set wS = Worksheets(k)
lastCol = wS.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To wS.Cells(Rows.Count, "B").End(xlUp).Row Step 6 '各Sheetの2行目～B列最終行まで6行おきに　★
'▼　「集計」Sheet作業列（B列）と一致する行を検索
Set c = .Range("B:B").Find(what:=wS.Cells(i, "A") & wS.Name, LookIn:=xlValues, lookat:=xlWhole)
'▼　各Sheetの「合計」行のC列～最終列までを「集計」Sheetの
If Not c Is Nothing Then
Range(wS.Cells(i, "C"), wS.Cells(i, lastCol)).Copy
.Cells(c.Row, "E").PasteSpecial Paste:=xlPasteValues
End If
Next i
Next k
.Range("A:B").Delete
Application.ScreenUpdating = True
.Activate
.Range("A1").Select
End With
End Sub 'この行まで

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

この回答へのお礼

ご教授ありがとうございます。
またお礼が遅くなりすみませんでした。

実際にはもう少し複雑なシートであったので、アドバイス頂いたものを参考に（素人なりに）種々頑張りましたが、結果旨く行きませんでした。（なのでリンク貼り付け、検索と置換を駆使して何とかして資料を作り上げました。）

マクロ（VBA）は非常に有効な手段だと思いますので、これから勉強して使いこなせるようになりたいと思います。

本当にありがとうございました。

お礼日時：2015/03/01 14:30