Snasui Excel Forum

Code: Select all

sub SaveAs_AllSheets_CSV_Format()
Dim sPath
sPath = ThisWorkbook.path & "\"
Dim SaveTodirectory
SaveTodirectory = "D:\ADI\"

txtFileName = Format(Date, "DDMMYYYY")

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In wb.Worksheets
ws.Copy
ActiveWorkbook.SaveAs sPath & 11214293 & "." & &O1& & "_" & txtFileName & ".csv", FileFormat:=xlCSV, local:=True
'ActiveWorkbook.SaveAs SaveTodirectory & 11214293 & "." & &O1& & "_" & txtFileName & ".xlsb", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    txtFileName = Format(Date, "DDMMYYYY")

ActiveWorkbook.Close False


Next ws



Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "done"
End Sub

Code: Select all

Dim i As Integer
'...Other code
For Each ws In wb.Worksheets
    i = i + 1
    ws.Copy
    ActiveWorkbook.SaveAs sPath & 11214293 & "." & i & O1 & "_" & txtFileName & ".csv", _
        FileFormat:=xlCSV, local:=True
    txtFileName = Format(Date, "DDMMYYYY")
    ActiveWorkbook.Close False
Next ws
'...Other code

Code: Select all

Sub SaveAs_AllSheets_CSV_Format()
Dim sPath
sPath = ThisWorkbook.path & "\"
Dim SaveTodirectory
SaveTodirectory = "D:\ADI\"

txtFileName = Format(Date, "DDMMYYYY")

Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Dim i As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False


For Each ws In wb.Worksheets
i = i + 1
ws.Copy
ActiveWorkbook.SaveAs sPath & 11214293 & "." & i & O1 & "_" & txtFileName & ".csv", _
        FileFormat:=xlCSV, local:=True
'ActiveWorkbook.SaveAs SaveTodirectory & 11214293 & "." & &O1& & "_" & txtFileName & ".xlsb", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    txtFileName = Format(Date, "DDMMYYYY")

ActiveWorkbook.Close False

Next ws

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "done"
End Sub