複数のエクセルの同じセルにファイル名一括入力

質問

複数のエクセルファイルが同じフォルダ上にあります。
内容は全く同じで、ファイル名だけが違うものです。
そのファイルそれぞれにファイル名を一括で入力するなんて事は可能でしょうか？
たとえばりんご.xls、ばなな.xls、みかん.xls・・・とありまして、
それぞれのセルA1にりんご　ばなな　みかん　と入れたいのです。
または、それが可能なフリーソフトなどありましたら情報が欲しいです。

回答No.1

DIooggooID · ベストアンサー

以下のようなマクロでは？

　※　この例では、　Ｄ：￥tmp　の　*.xls　　ファイルを
　　対象にしているので、　これらの部分を適当に修正してください。

Option Explicit
Dim ドライブ As String 'フォルダが存在するドライブ
Dim フォルダ As String 'フォルダ名
Dim 拡張子 As String 'ファイルタイプ（拡張子）
Dim パス As String 'パス
Dim ファイル名 As String 'ファイル名の取り出しエリア
'--------------------------------------------------------
Sub フォルダ中のファイル名をシートに書く()
ドライブ = "D" 'ドライブを指定する
フォルダ = "tmp" 'フォルダ名を指定する
拡張子 = "*." & "xls" '拡張子を指定する（この例は xls ）
指定フォルダ中の指定拡張子のファイル名をシートに書く
End Sub
'--------------------------------------------------------
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
パス = ドライブ & ":\" & フォルダ & "\" 'パスを組む
ファイル名 = Dir(パス & 拡張子) 'ファイル名を取り出す

Do While ファイル名 <> "" 'ファイル名がヌルでなければ
Workbooks.Open Filename:=ファイル名 'ファイルを開く
Range("A1").Select 'セル１を選択
ActiveCell.FormulaR1C1 = ファイル名 'ファイル名を挿入
ActiveWorkbook.Save 'ファイルを保存
ActiveWindow.Close 'ファイルを閉じる
ファイル名 = Dir() '次のファイル名を取り出す
Loop '繰り返し処理
End Sub