複数のシートの値を一つのシートに整列

よろしくお願いします。

複数のシートに行も列もバラバラになっているデータを一つのシートの行に整列させたいと思っています。
具体的には下記のようなシートがあります。一つは組織の名前のシート、一つは組織の基礎情報といった感じでシートごとに回答されています。
これを他のシートに一つの組織を一つの行で整列させ分析をしていきたいと思っています。
ファイルが数千あるため、マクロで書こうと思っているのですが、下記のように書いたのですがうまくいきません。

アドバイスをいただけないでしょうか？
ファイルは（アンケートデータ1,アンケートデータ2といった感じで統一、作業フォルダ内にすべて保存）
マクロを動かすセルは”統合”というファイル名、シート１に持ってきます。


Sub Macro1()
Dim i As Integer
For i = 1 To 1000
'アンケートデータファイルを開く

Workbooks.Open Filename:="C:\Documents and Settings\Administrator\My Documents\作業\アンケートデータ" & i" .xls

'アンケートデータファイル 学校名シートのB11　を新しいブックのシート１のA1にコピー

Worksheets(学校名).Activate
Range("B11").Select
Worksheets(統合).Activate
ActiveSheet.Paste
ThisWorkbook.Worksheets(1).Range("A" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Worksheets(基本データ).Activate
Range("D3").Select
Worksheets(統合).Activate
ActiveSheet.Paste
ThisWorkbook.Worksheets(1).Range("B" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Worksheets(基本データ).Activate
Range("D6").Select
Worksheets(統合).Activate
ActiveSheet.Paste
ThisWorkbook.Worksheets(1).Range("C" & i).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True




'アンケートデータファイルを閉じる
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Next i
End Sub



最終的には統合ファイル内で

　　　　　A（学校名）　　　　　　　　　B（学校区分）　　　 C（広さ）　　　D経営状況　　　E　　　F
１列　　アイウエオ学校　　　　　　　３　　　　　　　　　　　　　500　　　　黒字

２列　
　
といった感じで学校数文行で並ぶようにしたいのです。

上記の式の間違いの指摘、書き方についてアドバイスをください。

No.1 ベストアンサー 回答者： keithin 回答日時： 2013/02/11 14:31

イチイチ開いては閉じるしないマクロの書き方です

Sub macro1()
　Application.DisplayAlerts = False
　Worksheets("統合").Activate
　Range("A:C").ClearContents

　Range("A1") = "zzz'C:\Documents and Settings\Administrator\My Documents\作業\[アンケートデータ1.xls]学校名'!" 'Ｂ１１
　Range("A1:A1000").DataSeries Rowcol:=xlColumns, Type:=xlAutoFill
　Range("A:A").Replace what:="!", replacement:="!B11", lookat:=xlPart

　Range("B1") = "zzz'C:\Documents and Settings\Administrator\My Documents\作業\[アンケートデータ1.xls]基本データ'!" 'Ｄ３
　Range("B1:B1000").DataSeries Rowcol:=xlColumns, Type:=xlAutoFill
　Range("B:B").Replace what:="!", replacement:="!D3", lookat:=xlPart

　Range("C1") = "zzz'C:\Documents and Settings\Administrator\My Documents\作業\[アンケートデータ1.xls]基本データ'!" 'Ｄ６
　Range("C1:C1000").DataSeries Rowcol:=xlColumns, Type:=xlAutoFill
　Range("C:C").Replace what:="!", replacement:="!D6", lookat:=xlPart

　Range("A:C").Replace what:="zzz", replacement:="=", lookat:=xlPart
　Application.DisplayAlerts = True
End Sub



＃参考
間違いの指摘：
＞…アンケートデータ" & i" .xls

＆や”で閉じる”のように、手抜きせずキチンと書き切ります


＞Worksheets(学校名).Activate
＞Worksheets(統合).Activate
＞Worksheets(基本データ).Activate

worksheets("シート名")のように、””で囲って記入します

この回答へのお礼

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

お礼日時：2013/02/17 23:38