マクロで複数のエクセルブックにシートを挿入する

質問

フォルダ<<C:\Documents and Settings\MyPC\デスクトップ\Test>>の中に、あるアンケートに対する回答の"Book01.xls"～"BookXXX.xls"のエクセルファイルがあり、デスクトップ直下にその回答を一覧に並べるための"集計用ファイル.xls"があります。このアンケートの回答ファイルは日々数が追加されて行くので、毎日"集計用ファイル"に回答を得た分を転記し日付の名前でもつけて保存して行きたいのです。エクセルマクロを使用して、この"Book1"～"BookXXX"でシート名"Sum"のA1からA50に入力されている数値を"集計用ファイル"のA列から順に右へ右へと転記したいと考えています。（アンケートのエクセルブックは複数のシートから成っていますが、全ての答えが"Sum"シートのA1からA50に集計されるように作成してあります。）

ここで、一つ大きな問題がありまして集計用"Sum"シートを削除している回答用ブックが複数あります。（ロックまでかけていたのに…）

■質問
上記のケースで、"Sum"シートが削除されていた場合に追加するマクロを組みたいのですが、どのようなプロシージャーになるのか分かりません。この復活させたい"Sum"シートの原本は"集計用ファイル.xls"にある状態です。

VBA初心者なのですが、過去の質問を調べたり、べつの投稿で質問しながら下記の所まできましたが、また独力で解決できないので投稿させて頂きました。よろしくお願いいたします。

Sub 転記マクロ()

Dim WorkPath As String
Dim Target As String
Dim MaxColumn As Long

Application.ScreenUpdating = False

WorkPath = "C:\Documents and Settings\Zawa\デスクトップ\Test"
Target = Dir(WorkPath & "\*.xls", vbNormal)
MaxRow = 50

Do While Target <> ""
Workbooks.Open WorkPath & "\" & Target

Workbooks(Target).Sheets("Sum").Range("A1:A50").Copy _
ThisWorkbook.Sheets("Sum").Cells(MaxColumn, 1)
MaxColumn = MaxColumn + 1

Workbooks(Target).Close SaveChanges:=False
Target = Dir()
Loop

MsgBox "転記が終了しました。"
End Sub

回答No.1

hige_082 · ベストアンサー

対象ファイルSumシートの存在の確認
無ければ
集計用ファイル.xlsのSumシートを対象ファイルにコピー
ThisWorkbook＝集計用ファイル.xlsでないのなら
集計用ファイル.xlsを開く必要がある

Dim i As Integer

Do While Target <> ""
Workbooks.Open WorkPath & "\" & Target

For i = 1 To Workbooks(Target).Sheets.Count
If Workbooks(Target).Sheets(i).Name = "Sum" Then exitfor
If i = Workbooks(Target).Sheets.Count Then
Workbooks("集計用ファイル.xls").Worksheets("Sum").Copy _
After:=Workbooks(Target).Worksheets.Count
End If
Next i

Workbooks(Target).Sheets("Sum").Range("A1:A50").Copy _
ThisWorkbook.Sheets("Sum").Cells(MaxColumn, 1)
MaxColumn = MaxColumn + 1

Workbooks(Target).Close SaveChanges:=False
Target = Dir()
Loop

もうすぐ出勤なので検証できてませんが
参考までに

お礼

おお、なるほど！
勉強になりました。

ありがとうございました。
<(_ _)>