ブック中のシートをのフォルダーに保存するには？

質問

ブック中の複数シートの中の1シートをマイドキュメントなどに新しくフォルダーを作成しその中に保存するにはどうしたらいいでしょう？
フォルダーはその日の日付（2007.10.10）になるのが理想です。
シートの名前はシートの中のセルから参照するようにしたいです。

すみませんがご回答よろしくお願いします。

回答No.2

qualheart · ベストアンサー

以下の仕様になっています。
・保存したいシートを表示した状態で実行すること。
・保存されるエクセルファイル名は、シート名を引用する。
・すでに同名のファイルが存在する場合は、"-連番"がファイル名に付く。
・日付フォルダを作成する場所は、エクセルのツール→オプション→全般で設定されているカレントフォルダ内とする。

Sub Macro1()
Dim fs, f, s, strMyDoc, MyDate, FolderName, path, FileName, MyBook, MySheet
MyBook = ActiveWorkbook.Name
MySheet = ActiveSheet.Name
strMyDoc = Application.DefaultFilePath
dt = Format(Date, "yyyy.mm.dd")
path = strMyDoc & "\" & dt
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(path) = False Then
Set f = fs.CreateFolder(path)
End If
FileName = ActiveSheet.Name & ".xls"
If fs.FileExists(path & "\" & FileName) = True Then
For n = 1 To 10
FileName = ActiveSheet.Name & "-" & n & ".xls"
If fs.FileExists(path & "\" & FileName) = False Then
Exit For
End If
Next
End If
Set newBook = Workbooks.Add
newBook.SaveAs FileName:=path & "\" & FileName
Workbooks(MyBook).Worksheets(MySheet).Copy Before:=Workbooks(FileName).Sheets(1)
Workbooks(FileName).Save
End Sub

まあり検証はしてないので、環境によってはエラーが出るかも。
試してみてください。

お礼

大変参考になりました。
ありがとうございました。

回答No.3

taka_s777

ファイル名をどうするか、が書かれていませんのでとりあえずシート名と同じとしましたが
こんなかんじでいかがでしょうか。
※エラー処理はしてません。

Sub test()

mydir = Application.DefaultFilePath '保存フォルダ(例ではカレントフォルダパス)
myday = Format(Date, "yyyy.mm.dd") '今日の日付
myfile = Worksheets("Sheet1").Range("A1") 'ファイル名のセルアドレス
mysheet = Worksheets("Sheet1").Range("A1") 'シート名のセルアドレス
dirpass = mydir + "\" + myday '作成するフォルダパス

If Dir(dirpass, vbDirectory) = "" Then
MkDir (dirpass) 'フォルダ作成
End If

Worksheets("Sheet1").Copy 'コピー元のシート名指定
ActiveSheet.Name = mysheet 'シート名変更
ActiveWorkbook.SaveAs Filename:=dirpass + "\" + myfile + ".xls" '保存

End Sub

お礼

ありがとうございます。
大変参考なりました。

回答No.1

imogasi

これはVBAで回答する質問ですか。
どうもそうらしいが、どこにもそう書いてないようです。
ーー
手操作でやるなら
ー
問題のファイルを開く
ファイル
開く
ファイルを開くダイアロウグが出る
右クリック　新規作成
フォルダ
「新しいフォルダ」ができる
右クリックで「名前の変更」を選ぶ
日付に名前変更
ファイルを開く
新規作成
エクセルワークシート
新規MSExcelワークシート
ファイルを開く
エクセルワークシート
シートタブで右クリック
移動またはコピー
移動先新規MsExcelワークシート
コピーを作成する
OK
ーー
上記操作をマクロの記録に取れないかな。

補足

申し訳ありません。
マクロで自動化したいと思って質問しました。

できませんでしょうか？