• ベストアンサー

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

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

質問者が選んだベストアンサー

  • ベストアンサー
  • DIooggooID
  • ベストアンサー率27% (1730/6405)
回答No.1

以下のようなマクロでは?  ※ この例では、 D:¥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 'セル1を選択 ActiveCell.FormulaR1C1 = ファイル名 'ファイル名を挿入 ActiveWorkbook.Save 'ファイルを保存 ActiveWindow.Close 'ファイルを閉じる ファイル名 = Dir() '次のファイル名を取り出す Loop '繰り返し処理 End Sub

すると、全ての回答が全文表示されます。

関連するQ&A

PX-048A
このQ&Aのポイント
  • chrome-bookからエプソンプリンタに簡単に印刷できる方法を紹介
  • chromeOS上でのエプソンプリンタの設定手順を解説
  • エプソンプリンタを使った高品質な印刷をchrome-bookで実現
回答を見る

専門家に質問してみよう