【VBA】フォルダ内の複数Excelのセルをコピー

お世話になります。
初級者ですが、Excel 2002のVBAについてご質問をさせて頂きます。


【概要】
　あるフォルダ内にある複数のExcelファイルの、特定のセルを
　1つのExcelファイルに集約します。

【詳細】
　1.あるフォルダ内に複数のExcelファイルがあります。Excelファイルの数は、その日によって
　　ことなります。
　2.選択画面から、この複数のExcelファイルを選択し、選択したExcelファイルの
　　それぞれの「A1セル」「B1セル」「C1セル」を、「1つのExcelファイル」に張り付けます。
　3.「貼り付け」→「次の列へ移動」→「貼り付け」→「次の列へ移動」というサイクルを、
　　選択したExcelファイルの数だけ繰り返します。
　4.集約したExcelファイルのイメージは以下のとおりです。

　　　　　　 A列 B列 C列 D列 E列 F列 G列 H列　 。。。。
　　1行目　A1 A1 A1 A1 A1 A1 A1 A1　。。。。
　　2行目　B1 B1 B1 B1 B1 B1 B1 B1　。。。。
　　3行目　C1 C1 C1 C1 C1 C1 C1 C1　。。。。


教えて！gooの回答で、「複数のシートを、1つのExcelファイルに集約する」ものがあったので、
それを参考にしようとしましたが、僕の実力ではできませんでした。

ご助言を頂けると非常に助かります。よろしくお願いします。

No.3 ベストアンサー 回答者： merlionXX 回答日時： 2011/08/13 23:00

一例です。

ただ、シート名に一切言及がなかったので、複数選択した転記元ファイルについては開いたときに表示されるシート、転記先はこのマクロを書いたファイルのSheet1という名前のシートを対象としました。
フォルダを選択したら、対象とする複数のファイルを選択してください。（Ctrlボタンを押しながらファイルを選べば複数ファイルの選択ができます。）

Sub test01()
　　Dim Bks, wb
　　Bks = Application.GetOpenFilename(FileFilter:="Microsoft Excelブック,*.xls", MultiSelect:=True)
　　If IsArray(Bks) Then
　　　　Application.ScreenUpdating = False
　　　　For Each wb In Bks
　　　　　　Workbooks.Open wb
　　　　　　n = n + 1
　　　　　　ActiveSheet.Range("A1:C1").Copy
　　　　　　ThisWorkbook.Sheets("Sheet1").Cells(1, n).PasteSpecial Paste:=xlPasteAll, Transpose:=True
　　　　　　Application.CutCopyMode = False
　　　　　　ActiveWindow.Close (False)
　　　　Next
　　　　Application.ScreenUpdating = True
　　Else
　　　　MsgBox "キャンセル"
　　End If
End Sub

この回答へのお礼

的確なアドバイス、有難う御座います。
僕のイメージどおりの、集約したExcelファイルができました。

今後、「F1」「A3」など、飛び飛びのセルも集約の対象になる見込みなのですが、
merlionXXさんのアドバイスを参考にさせて頂いて、対応したいと思います。

お礼日時：2011/08/14 10:07

No.2 回答者： imogasi 回答日時： 2011/08/13 20:57

基本的には、＞あるフォルダ内にある複数のExcelファイル、はすべて処理対象にするのだろう？

そのうち処理対象からはずすのはあるのか（集約ブックは別として）？。そのために操作者への表示と確認が必要なのか。
ーー
初心者といって、ここに質問する前に、あるフォルダのすべてのファイル（エクセルファイルだけでも良い）を掴むコードを勉強するべきだ。Googleで照会すれば沢山あるはず。ここへの質問もたびたび出てくる。
Googleで「フォルダ　すべて　ファイル　列挙」などで照会する。
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub0 …　など。
定石としてVBSでやる方法、DIR関数、その他がある。
下記はVBSをつかう。エクセルのブック（データを集約するブックででも）の標準モジュールに
Sub test01()
On Error Resume Next
Dim FSO 'Scripting.FileSystemObject
Dim objFolder 'Folderオブジェクト
Dim oFile 'Fileオブジェクト
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\Documents and Settings\XXXX\My Documents\")
For Each oFile In objFolder.Files
If Right(oFile, 4) = ".xls" Then
MsgBox oFile.Name
End If
Next
End Sub
ーー
ファイルをとらえたら、エクセルでOpen　する。
そのブックのシートSheet1のA1セルなどの値を掴む。
Sub test01()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Dim FSO 'Scripting.FileSystemObject
Dim objFolder 'Folderオブジェクト
Dim oFile 'Fileオブジェクト
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSO.GetFolder("C:\Documents and Settings\XXXX\My Documents\")
For Each oFile In objFolder.Files
If Right(oFile, 4) = ".xls" Then
'MsgBox oFile.Name
Workbooks.Open oFile
MsgBox Worksheets("Sheet1").Range("A1")
ActiveWorkbook.Close SaveChanges:=True
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
ーーーー
集約するブックへのコードはA->Bブックの例でマクロの記録を採って考えてみては。
でもさらに色々疑問点はあろうが、１つ１つやるほか無い。そういう疑問点の質問ににこのコーナーは使うべきだ。

この回答へのお礼

早急なアドバイス、有難う御座います。

>集約するブックへのコードはA->Bブックの例でマクロの記録を採って考えてみては。
でもさらに色々疑問点はあろうが、１つ１つやるほか無い。そういう疑問点の質問ににこのコーナーは使うべきだ。

→imogasiさんのいうとおり、僕がもう少し努力をしてから質問をすべきでした。
今後はそのようにします。

お礼日時：2011/08/14 10:13

No.1 回答者： kmetu 回答日時： 2011/08/13 16:00

とりあえず複数のファイルを選択して開く

↓の最後にやり方があります。
http://officetanaka.net/excel/vba/file/file02.htm

> Excelファイルの数だけ繰り返します

これも上記のサイトが参考になります。

あとは説明するまでもないですよね。

この回答へのお礼

アドバイスを頂きまして、有難う御座います。

URLを確認しました。
様々な方法があるのですね、勉強になります。

>あとは説明するまでもないですよね。

→ファイル選択後の処理も、今の僕には難しいですが、
　努力してみます。

お礼日時：2011/08/14 10:17