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




Reply With Quote
Bookmarks