I'm sure you can modify this to suit your need.
Code:
Sub CSVExportTest2()
Dim tmpWS As Worksheet
Application.DisplayAlerts = False
Dim strPath As String, filePath As String
strPath = ThisWorkbook.Path & "\" & ThisWorkbook.Range("B2").Value & "-" & ThisWorkbook.Range("B2").Value
MkDir strPath
For Each ws In ThisWorkbook.Worksheets
If ws.Index > 1 Then
filePath = exportPath & "" & ws.Name & ".csv"
ws.Copy
Set tmpWS = ActiveSheet
tmpWS.SaveAs Filename:=filePath, FileFormat:=xlCSV
tmpWS.Parent.Close False
End If
Next
Name ThisWorkbook.Path & "\header.txt" As strPath & "\header.txt"
End Sub
Bookmarks