excelで１つのファイルに統合するには

質問

excelファイルが30個ありまして、それを1つのexcelファイルに集約したいのですが、
各ファイルはシート毎に分かれて30シートになるようにするには、
どのようなVBAを組めばいいのか、お教え下さい。

回答No.2

mitarashi · ベストアンサー

既存のひな形に付け加えたので、あるフォルダに存在する、すべてのシートを、このマクロを登録したブックにコピーするコードです。外していたらすみません。
ちょっとだけ動かして確認しましたが、多分動くでしょう。（Excel2007では無理かもしれませんが）少々長いのでインデントの修正してないですが、ご容赦を。
Sub treatAllFiles()
Dim FSO As Object
Dim folderName As String
Dim targetFolder As Object
Dim targetFiles As Object
Dim targetFile As Object
Dim sh As Worksheet

'????? は環境に合わせる事
folderName = "C:\Documents and Settings\?????\My Documents\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set targetFolder = FSO.getfolder(folderName)
Set targetFiles = targetFolder.Files

For Each targetFile In targetFiles
DoEvents '途中でやめたくなった時のための保険
If (Right(targetFile, 4) = ".xls" Or Right(targetFile, 4) = ".XLS") Then
Application.Workbooks.Open targetFile
For Each sh In Application.ActiveWorkbook.Worksheets
sh.Copy Before:=ThisWorkbook.Sheets(1)
Next
Windows(FSO.GetFileName(targetFile)).Activate
Call ActiveWorkbook.Close(savechanges:=False)
End If
Next targetFile
End Sub

お礼

GOODです。
理想どおりでした。
ありがとうございました。

補足

ちなみに("Scripting.FileSystemObject")は何ですか？

回答No.5

mitarashi

#2です
Scripting.FileSystemObjectについては、
参考URLをご覧下さい。自分もいつもお世話になっているサイトです。
これを使いこなすと、フォルダー、ファイル、テキストファイル等を操作するのに便利です。

参考URL：

http://officetanaka.net/excel/vba/filesystemobject/index.htm

お礼

了解です。ありがとうございます。

回答No.4

imogasi

この質問で良く意味が判らない。
＞excelファイルが30個ありまして
１ファイル１シートか。複数シートがあるものもあるのか。
＞各ファイルはシート毎に分かれて30シートになるようにするには
＞各ファイルはシート毎に分かれて
各ファイルとは３０個のファイルですね。
＞シート毎に分かれて30シートになるようにするには
とはどういう意味ですか。ファイルはシートごとに分かれているのは当たり前ではない？。
＞集約したいのですが
集約とは。
３０個のファイルにあるそれぞれのシートを１個のファイルに集めるとして、＞30シートになるようにするには、とは。
ーーー
結局
３０個のファイルにあるシートを全て１つの（新しい）ファイルに集めたい（コピーして集めたファイルを作りたい）で良いのかな。

回答No.3

at121

このマクロのあるBOOKのあるフォルダに存在する、すべてのBOOKのシート（１）を、このマクロのあるBOOKにコピーするマクロです。
移動するシート名は重複しないようにBOOK名からとります。
もとのBOOKにsheet1が存在しないように。
sheet１吸い上げ　処理後　BOOKは　KILL削除　します。

Sub Dir内XLSブックをシートに統合()
'
Set WBook = ThisWorkbook
With Application.FileSearch
.Filename = "*.xls"
.LookIn = CurDir
If .Execute() > 0 Then
nn = .FoundFiles.Count
For i = 1 To .FoundFiles.Count
If WBook.Path + "\" + WBook.Name <> .FoundFiles(i) Then
Workbooks.Open Filename:=.FoundFiles(i)
shn = ActiveWorkbook.Name
Sheets(1).Copy Before:=WBook.Sheets(1)
WBook.Sheets(1).Name = Left(shn, Len(shn) - 4)
Workbooks(shn).Close
Kill (.FoundFiles(i))
End If
Next i
MsgBox CStr(nn - 1) + "個の.xlsブックを吸い込み統合しました。"
Else
MsgBox "統合する.xlsファイルはありません。"
End If
End With

End Sub

お礼

回答ありがとうございます。
ちょっと動かすのにてこずりましたが上手くいきました。

回答No.1

ZELDA-LINK

ＶＢＡでは不可能かと・・・。
地道にファイルを開いて、シートの移動（またはコピー）で１つのＥＸＣＥＬファイルにする方が、回答を待つより早いと思います。
面倒でしょうが、頑張ってください。