Save worksheets as text files
Sub SaveSheetsAsTextFiles()Dim originalFileName As String
Dim originalSheetName As String
Dim anyWS As Worksheet
Dim rootPath As String
Dim newName As String
Dim theYear As String
Dim theMonth As String
Dim theDay As String
Dim whereAmI As String
'you can assign a path to this like
' rootPath = "C:\folder1\folder2\folder3\"
'but this uses path to folder where the
'Excel file is stored
rootPath = ActiveWorkbook.path
If Right(rootPath, 1) <> Application.PathSeparator Then
rootPath = rootPath & Application.PathSeparator
End If
originalFileName = ActiveWorkbook.FullName ' path and name!
theYear = CStr(Format(Year(Now()), "0000")) ' 4 digit year
theMonth = CStr(Format(Month(Now()), "00")) ' 2 digit month
theDay = CStr(Format(Day(Now()), "00")) ' 2 digit day
'remember where we are in the workbook
whereAmI = ActiveSheet.Name
'turn off alerts to the user
Application.DisplayAlerts = False
'prevent screen flickering and improve speed
Application.ScreenUpdating = False
For Each anyWS In ActiveWorkbook.Worksheets
'must actually activate the sheet
anyWS.Activate
originalSheetName = ActiveSheet.Name
'set up new name for the text file
'you can easily change the sequence for the date portion
'as set up all sheet names will be grouped together and
'in date order from newest to oldest when viewed in file browser
newName = rootPath & ActiveSheet.Name _
& ".txt"
'save the sheet as a TAB DELIMITED text file
ActiveWorkbook.SaveAs _
Filename:=newName, FileFormat:=xlText
'change the sheet name back to its original name
anyWS.Name = originalSheetName
Next
'and get the workbook back to its original name
ActiveWorkbook.SaveAs _
Filename:=originalFileName, FileFormat:=xlNormal
'restore normal user alerting feature
Application.DisplayAlerts = True
'and return to the sheet you started on
Worksheets(whereAmI).Activate
End Sub
Save worksheets as csv files
Sub ExportSheetsToCSV()Dim originalFileName As String
Dim originalSheetName As String
Dim anyWS As Worksheet
Dim rootPath As String
Dim newName As String
Dim theYear As String
Dim theMonth As String
Dim theDay As String
Dim whereAmI As String
'you can assign a path to this like
' rootPath = "C:\folder1\folder2\folder3\"
'but this uses path to folder where the
'Excel file is stored
rootPath = ActiveWorkbook.Path
If Right(rootPath, 1) <> Application.PathSeparator Then
rootPath = rootPath & Application.PathSeparator
End If
originalFileName = ActiveWorkbook.FullName ' path and name!
theYear = CStr(Format(Year(Now()), "0000")) ' 4 digit year
theMonth = CStr(Format(Month(Now()), "00")) ' 2 digit month
theDay = CStr(Format(Day(Now()), "00")) ' 2 digit day
'remember where we are in the workbook
whereAmI = ActiveSheet.Name
'turn off alerts to the user
Application.DisplayAlerts = False
'prevent screen flickering and improve speed
Application.ScreenUpdating = False
For Each anyWS In ActiveWorkbook.Worksheets
'must actually activate the sheet
anyWS.Activate
originalSheetName = ActiveSheet.Name
'set up new name for the text file
'you can easily change the sequence for the date portion
'as set up all sheet names will be grouped together and
'in date order from newest to oldest when viewed in file browser
newName = rootPath & "VO_CSVs_Ankur\" & ActiveSheet.Name _
& ".csv"
'save the sheet as a TAB DELIMITED text file
ActiveWorkbook.SaveAs _
Filename:=newName, FileFormat:=xlCSV
'change the sheet name back to its original name
anyWS.Name = originalSheetName
Next
'and get the workbook back to its original name
ActiveWorkbook.SaveAs _
Filename:=originalFileName, FileFormat:=xlNormal
'restore normal user alerting feature
Application.DisplayAlerts = True
'and return to the sheet you started on
Worksheets(whereAmI).Activate
End Sub
Replace all endline characters
Sub RemoveCarriageReturns()Dim MyRange As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each MyRange In ActiveSheet.UsedRange
If 0 < InStr(MyRange, Chr(13)) Then
MyRange = Replace(MyRange, Chr(13), "")
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
