複数ファイルの同じ位置のセル内容を、それぞれファイル名・シート名にして保存したい

質問

VBA初心者ですが、いろいろなＱ＆Ａを検索して、やりたいことの解決方法を模索しているのですが、私の疑問にドンピシャの回答が見つからず悩んでいます。
目的は、あるフォルダ内の、複数のランダムなファイル名のエクセルファイルについて、それぞれのファイルを開き、アクティブシートのＡ１セルの入力内容に基づき、そのシートの名前を変更し、ファイル名も変更して保存するという作業です。（例えば、Ａ１に「山田」と入っていたら、シート名も「山田」にして、「山田.xls」で保存する。）
マクロの自動作成で、例えば「Ａ」というファイルは開いてシート名を変え、ファイル名を付けて保存するくらいのことはできるのですが、ファイル名がランダムに代わったり、ファイル数が複数になるとできません。
このようなマクロを作ることは可能なのでしょうか？。
よろしくお願いいたします。

回答No.3

kuma3f · ベストアンサー

思われていることと違っていましたらすみませんが、次のコードを新規Ｂｏｏｋのマクロに貼り付けて、そのＢｏｏｋを変換したいファイルのあるフォルダーの中に自由な名前をつけて保存し、保存したＢｏｏｋを開いてそのマクロを実行してみてください。
既存のファイルを壊してはいけないので、必ず、コピーしたフォルダー内でテスト的に行ってみてください。

新規ＢｏｏＫを開く
　↓
メニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
マクロのダイアログが表示されたらマクロ名に自由に名前を入力してください。（例：変換）
　↓
名前を入力しましたら、「作成」をクリック
　↓
Microsoft Visual Basicの画面が開きますのでSub 変換()の下に次のコードをコピーして貼り付けてください。

Dim パス名 As String 'フォルダーのパス
Dim 当ファイル名 As String 'このファイル自体の名前
Dim ファイル数 As Long 'フォルダー内のファイル数のカウント
Dim 対象ファイル As String
Dim 変更前の名前 As String
Dim 変更後の名前 As String

Application.ScreenUpdating = False
パス名 = ActiveWorkbook.Path & "\"
当ファイル名 = ActiveWorkbook.Name
当ファイル名 = パス名 & 当ファイル名
Sheets("Sheet1").Select
Cells.Clear
With Application.FileSearch 'ファイルの検索
.NewSearch
.LookIn = パス名
.Filename = "*.xls"
.SearchSubFolders = True
If .Execute() > 0 Then
For ファイル数 = 1 To .FoundFiles.Count
'パス＆ファイル名の取得（当ファイルを除く）
If 当ファイル名 <> .FoundFiles(ファイル数) Then
Sheets("sheet1").Cells(ファイル数, 1) = .FoundFiles(ファイル数)
Workbooks.Open Filename:=.FoundFiles(ファイル数) 'ファイルのOPEN
対象ファイル = ActiveWorkbook.Name
変更前の名前 = ActiveWorkbook.ActiveSheet.Name
変更後の名前 = Workbooks(対象ファイル).Sheets(変更前の名前).Range("A1")
ActiveWorkbook.ActiveSheet.Name = 変更後の名前
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=パス名 & 変更後の名前 & ".xls" '保存
Application.DisplayAlerts = True
ActiveWorkbook.Close False 'ファイルのCLOSE
End If
Next
End If
End With
Application.ScreenUpdating = True
MsgBox "変換が終了しました。"

'****コピー貼り付けはここまで ****

Microsoft Visual Basicの画面を×で閉じます
　↓
この新規Ｂｏｏｋを変換したいファイルのフォルダー内に名前をつけて保存します
　↓
保存したらこのＢｏｏｋを開く
　↓
Excel画面のメニューバーの「ツール」→「マクロ」→「マクロ」をクリック
　↓
先ほど名前を付けたマクロ（変換）を選択して「実行」をクリック

Ａ１に「山田」と入っていたら、シート名「山田」、ファイル名「山田.xls」で作成されていると思います。

お礼

どんぴしゃの回答をいただきました。ありがとうございます。
できれば、変更後のファイルは別のフォルダに入れたいのですが、そこからは自分で考えてみます。それと、教えていただいた方法の勉強もやります。それで、疑問や分からないことがあればまた質問してみたいと思います。
本当にありがとうございました。

回答No.2

imogasi

まず注目点は、「数ファイル」といっているが、どういう範囲のブックなのか。はっきり認識すること。
（１）フォルダ内全部
（２）フォルダ内全部のブックのシートの情報で取捨選択
名前の一部で取捨する
（３）名前の一覧にあるかで判別
その他などはっきり表現すること。
ーーー
マクロの自動作成で、例えば「Ａ」というファイルは開いてシート名を変え、ファイル名を付けて保存するくらいのこと（Ａ）はできるのですが・・
なんだから変えるところを変数１にするのだ（とりあえず、何か語句に置き換えて書き表してみる）。
そして（Ａ）を繰り返し実行するとき、変えるべき箇所があるが、それを表す変数に、その回の正しい値を
セットするのだ（このスキルが難しいのかも）
ーー
繰り返しをＦｏｒＮｅｘｔでやるとすると
For i=1 to ブック数
ファイル名=iの変数で特定できる仕組みを作る。
上記で割り出したファイル名でブックをオープン
処理ーー＞アクティブシート（＜－Ｘ決まった名前かインデックス）のＡ１セルの入力内容を変数２に入れる。
シート名を変更
保存する（同じ名前でよいのか）
ーー
（１）（２）の場合だと「Ｆｏｒ　Ｅａｃｈ」が適当かと思う
ＷＥＢでこの語句で照会し例を見ること。
(注）アクチブなシートはいくらでも操作で変わりえる。保存された状態でアクチブシートを見つけることはたやすいが、閉じるとき、フイにシートタブをクリックしたりがありえるので、不安定な気がする。
ーーー
まだまだ質問者はＷＥＢや本の実例を自分の二ーズにあわせて修正出来るレベルでないようだ。
本質問も、色んな似たＷＥＢ・本の実例を挙げて変更し、行き詰まった点の質問になっていないので、この問題も説明してもむだなような気がする。
丸投げ・どんぴしゃ回答に頼らざるを得ないかな。

お礼

おっしゃるとおりでぐうの音も出ません。

回答No.1

merlionXX

> このようなマクロを作ることは可能なのでしょうか？

あるフォルダ内の、複数のランダムなファイル名をどうやって判定するのですか？
たとえば、
ある特定のフォルダ内の全てのエクセルファイル
ある特定のフォルダ内のファイル名に、ある特定な文字列がある全てのエクセルファイル　等、識別できる要素があれば可能です。

補足

ありがとうございます。
特定する方法は、前者つまり「ある特定のフォルダ内の全てのエクセルファイル」です。