create individual csv files from sheets in an excel file

http://q.hatena.ne.jp/1170586981

名前をつけて保存をシート単位に繰り返すマクロです。

問題は保存する形式がCSVになってしまいます。

上書き保存しても構わなければ、最後から2行の

ActiveWorkbook.SaveAs　〜

を有効にしてくださ

以下マクロのソースです。

Sub Macro1()
Dim ws As Worksheet
Dim cvsDir As String
Dim csvPrefix As String
Dim wsName As String

' このブックのパスを取得
csvPrefix = ThisWorkbook.Path + "\" + ThisWorkbook.Name
csvPrefix = Left(csvPrefix, Len(csvPrefix) - 4)

' シートの数だけループを回す
For Each ws In ThisWorkbook.Sheets
ws.Activate
wsNname = ws.Name
ws.SaveAs Filename:=csvPrefix + "_" + wsNname + ".csv", FileFormat:=xlCSV, _
CreateBackup:=False
ws.Name = wsNname
Next
' ActiveWorkbook.SaveAs Filename:=csvPrefix + "xls", FileFormat:=xlNormal
End Sub