エクセルVBAでファイル名を変えて保存するには

お世話になります。

デスクトップの「ABC」フォルダ内に複数のエクセルシートがあり
各エクセルシートの　A2欄に　日付データが記載されているのですが

エクセルVBAでA2欄ある日付情報をファイル名にして
デスクトップの「DEF」フォルダに保存したいと思っています。

VBAで可能でしょうか？
またどのような記述をすればよろしいでしょうか？
ご教示いただければ幸いに存じます。

質問者からの補足コメント

• ＞「ABC」フォルダ内の複数エクセルシートを順番に全部「DEF」フォルダに名前を変えて保存したいという事ですか？
  ＞vba一発で自動化したい？
  
  はい。　2点ともご指摘の通りです。
  出来ますでしょうか？

    補足日時：2016/06/01 10:33

No.2 ベストアンサー 回答者： t_fumiaki 回答日時： 2016/06/01 13:09

サンプルです。

「ABC」「DEF」のフルパスを正しく記載すれば動きます。
xlsxの場合はサンプルのxlsを修正して下さい。

vbaを貼り付けたエクセルをデスクトップ以外の場所に格納して実行して下さい。


Sub WK()
Dim buf As String
Dim newfilename As String
Dim oldfilename As String
Dim Sh As Worksheet
Const Path As String = "C:\Users\user\Desktop\ABC\"

'ファイル一覧を取得
buf = Dir(Path & "*.xls")
Do While buf <> ""

'ブックを開く
Workbooks.Open "C:\Users\user\Desktop\ABC\" & buf
oldfilename = buf
buf = Dir()

'A2のファイル名を取り込む
newfilename = Workbooks(oldfilename).Worksheets(1).Range("A2")

'ブックを名前を付けて保存
Workbooks(oldfilename).SaveAs filename:="C:\Users\user\Desktop\DEF\" & newfilename

'ブックを閉じる
Workbooks(newfilename & ".xls").Close

Loop

E4: Application.StatusBar = False
End Sub

この回答へのお礼

ありがとうございます。

はじめ、C:\Users\user\Desktop\のパスが違っていてエラーになりましたが、　\user　を変えたらうまくいきました！！

すばらしいです！！

御礼申し上げます。

お礼日時：2016/06/01 20:43

No.1 回答者： t_fumiaki 回答日時： 2016/06/01 10:15

「ABC」フォルダ内の複数エクセルシートを順番に全部「DEF」フォルダに名前を変えて保存したいという事ですか？

vba一発で自動化したい？