シート毎に保存

質問

１つのブックに５０以上のシートがあります。
シート名をブック名（ファイル名）として、シート１枚ごとに
保存するマクロを教えて下さい。
マクロ自体分からない者ですが、

回答No.2

BlueRay · ベストアンサー

書き換える場所は、
SvPath = ""　←このままだと、「My Documents」に保存されます。
を保存したい場所に書き換えるだけで後は全て自動でやってくれます。
例：
SvPath = "D:\MyDocs\分割\"
（最後に「\」はつけてくださいね。）

'---------- 貼り付けるソースはココから ----------
Sub SheetSave()
　　Dim i As Integer
　　Dim j As Integer
　　Dim SvPath As String
　　Dim BookName As String
　　Dim SheetName As String

　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False

　　SvPath = ""

　　For i = 1 To ActiveWorkbook.Worksheets.Count
　　　　BookName = ActiveWorkbook.Name
　　　　SheetName = ActiveWorkbook.Worksheets(i).Name

　　　　Workbooks.Add
　　　　Workbooks(BookName).Sheets(SheetName).Copy Before:=Workbooks(2).Sheets(1)
　　　　For j = Workbooks(2).Worksheets.Count To 2 Step -1
　　　　　　Workbooks(2).Sheets(j).Delete
　　　　Next

　　　　Workbooks(2).SaveAs Filename:= _
　　　　　　SvPath & Workbooks(BookName).Sheets(SheetName).Name & ".xls", FileFormat:=xlNormal, _
　　　　　　Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
　　　　　　CreateBackup:=False

　　　　Workbooks(2).Close
　　Next

　　Application.DisplayAlerts = False
　　Application.ScreenUpdating = False
End Sub
'---------- 貼り付けるソースはココまで ----------

ソースの貼り付け方は、No1さんを参考してもらえばＯＫです。
ちなみに、VisualBasicEditorの起動は「Alt」を押しながら「F11」で出来ますよ。

お礼

有り難うございます。
BlueRaiと＃１さんと結果は同じになるのだと思います。
やってみます

回答No.3

misatoanna

＃1の補足です。
８行目あたりの Filename:="C:\_Ann's\Zone_1\" の部分は、 toyohei さんの実際のパスに置き換えてください。

回答No.1

misatoanna

分割したいブックを呼び出し、[Alt]キーを押しながら [T],[M],[V],[I],
[M] の順にキーを押してください。
Visual Basic Editor のモジュール画面が表示されますので、画面右半分の
空白領域に、次の英文コマンドをコピー・貼り付けしてください。
なお、４行目の"4"は、ブック内のシート枚数です。実際の数字に置き換えて
ください。
'------- コピーは 次行から ------------
Sub Sheet2Book()
Application.ScreenUpdating = False
NMB = ActiveWorkbook.Name
For L = 1 To 4
Sheets(L).Select
NMS = ActiveSheet.Name
Sheets(NMS).Copy
ActiveWorkbook.SaveAs Filename:="C:\_Ann's\Zone_1\" & NMS & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close False
Windows(NMB).Activate
Sheets(1).Select
Next L
Application.ScreenUpdating = True
End Sub
'------- コピーは 前行まで ------------
コピーしたら VBEditor 画面を終了してエクセル画面に戻します。
で、[ツール]-[マクロ]-[マクロ] から Sheet2Book を選択して[実行]。
以上です。
※上記マクロ４行目で実際の枚数より多い数字を指定して実行するとエラー
　メッセージが出ます。
　この場合は[終了]をクリックしてください。これでも処理は完了しています
　ので、気にしなてＯＫです。