Excel VBA 複数シートを各シート名で保存

質問

Excel VBA で、複数シートを各シート名で保存したい場合はどうすればいいでしょうか？

シート名が、[フォーム] [Ａ社] [Ｂ社] [Ｃ社] [Ｄ社] …
というBookがあります。
[フォーム]シートを除く他のシートを、シート名をそのままファイル名にして、
それぞれ別ファイルで保存する場合、どのように記述すればいいのか
どなたかおわかりになりましたら、教えてください。

よろしくお願いします。

回答No.1

HohoPapa · ベストアンサー

ブックを保存するときに、
保存するシートを指定する機能はありませんので
・新規ブックを開き、
・必要なシートを複写し
・その新規ブックをシート名で保存する。
という繰り返しになりましょう。

都合、
こんなカンジでしょうか。

Sub testqq()

　'分解保存元のブックが開いている状態で実行

　Dim wkSheets As Integer　　'原本ブックのシート数
　Dim wkCounts As Integer　　'作業用カウンター
　Dim TempName As String　　 'テンポラリーなブック名
　Dim KeepName As String　　 '保存先シート名かつ、ブック名

　Const MotoBook = "元.xlsx"

　With Workbooks(MotoBook)
　　wkSheets = .Sheets.Count
　　For wkCounts = 1 To wkSheets
　　　If .Sheets(wkCounts).Name <> "フォーム" Then
　　　　KeepName = .Sheets(wkCounts).Name
　　　　Workbooks.Add
　　　　TempName = ActiveWorkbook.Name
　　　　.Sheets(KeepName).Copy Before:=Workbooks(TempName).Sheets(1)
　　　　ActiveWorkbook.SaveAs FileName:=ThisWorkbook.Path & "\" & KeepName & ".xlsx", _
　　　　　　FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
　　　　ActiveWorkbook.Close
　　　End If
　　Next wkCounts
　End With

End Sub