Excel into CSV VBA - vba

I am having trouble saving one sheet from my workbook into a CSV file. I have 18 sheets in the one workbook. Every time I run the macro, it saves a different sheet. I also need it so the display alerts do not pop up. I am a beginner to VBA and running macros, so any help would be appreciated.
Sub csvfile()
'
' csvfile Macro
'
'
ChDir "C:\Users\RM\Documents"
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\RM\Documents\Working_Program\PSSE_Export_Data.csv", FileFormat:= _
xlCSV, CreateBackup:=False
Application.DisplayAlerts = False
End Sub

This should do the trick, Just specify the sheet that you want to save in place of "Sheet1"
Sub csvfile()
Application.DisplayAlerts = False
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
ws.SaveAs Filename:= _
"C:\Users\RM\Documents\Working_Program\PSSE_Export_Data.csv", FileFormat:= _
xlCSV, CreateBackup:=False
End Sub

Related

Converting workbook in PDF without blank pages

Hiii
I wrote a code to export sheets from one workbook to an other workbook and then convert it in pdf, but I have a lot of blank pages (maybe because of hidden formula or I don't know.
If you have any idea for what to add to my code in order to have a decent file it would be very appreciated.
Workbooks.Open FileName:="C:\Users\User\Documents\Tests Salome\dailypdf.xlsx"
Dim wbto2 As Workbook: Set wbto2 = Workbooks("dailypdf.xlsx")
wb.Activate
For Each sht In Sheets
If sht.Name <> "USD" And sht.Name <> "Balance" Then
Else
sht.Copy Before:=wbto2.Sheets(wbto2.Sheets.Count)
Rows("140:351").EntireRow.Delete '(I tried to delete the hidden rows)
End If
Debug.Print sht.Name
Next
wbto2.Activate
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
FileName = Create_PDF(Source:=wbto2, _
FixedFilePathName:=iFile, _
OverwriteIfFileExist:=True, _
OpenPDFAfterPublish:=False)
The code functions but the result does not satisfy me because of the blank pages..
you can try any option below
1.Delete all unwanted rows before saving as PDF.
2.Set Print area
3.try to save excel range as PDF directly
'Enter Worksheet name, range Address, PDF file path and name
Sheets("Sheet Name").Range("A1:D50").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Temp\PDF_name.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True

Excel VBA - Create Another Excel File with Password Protected

I have a Excel Program that need to create another excel with password protected. I can create another excel but i don't know how to protect it with password. Below are the code for the creating another Excel File.
Option Explicit
Sub Macro1()
Dim Wk As Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:=”B:\Test1.xlsx”
Application.DisplayAlerts = True
End Sub
Hope you guys can help for this part.
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs FileFormat:=xlNormal, Password:="pass", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close
Here is the documentation: Workbook.SaveAs Method (Excel)

Excel Macro to Copy & Paste Values from Multiple Sheets to Separate Text Files

I am trying to build a macro to export multiple sheets (with named tabs) to separate text files. The original .xlsm file has formulas built in, so I am trying to paste the values from each named worksheet into individual text files. The script below works, but only saves the main Excel file as .xlsx and the active worksheet.
I am trying to copy/paste all worksheets, but my script is not working:
Sub SaveSheetsAsTxt()
'
' SaveSheetsAsTxt Macro
'
Dim ws As Worksheet
Application.DisplayAlerts = False
'save as XLSX
ActiveWorkbook.SaveAs Filename:="V:\tech\dd\FUND_HOLDINGS.xlsx", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
MyPath = ThisWorkbook.Path
For Each ws In ThisWorkbook.Sheets
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs Filename:="V:\tech\dd" & "\" & ActiveSheet.Name & ".txt", _
FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=False
Next ws
End Sub
Thank you in advance for any help!
There are a couple of things wrong with what you have there.
The Close statement doesn't need to be called inside the loop
The FileFormat for the .xlsx workbook needed to be changed to work properly when saving from .xlsm to .xlsx. it should be xlOpenXMLWorkbook
As Scott pointed out, you should activate the worksheet that you are trying to save each time as you iterate.
Sub SaveSheetsAsTxt()
Dim ws As Worksheet
Application.DisplayAlerts = False
'save as XLSX
Worksheets.Copy
ActiveWorkbook.SaveAs Filename:="V:\tech\dd\FUND_HOLDINGS.xlsx", _
FileFormat:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
' Close the newly created xlsx file
ActiveWorkbook.Close
'loop through the worksheets
For Each ws In ThisWorkbook.Sheets
ws.Activate
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs Filename:="V:\tech\dd" & "\" & ActiveSheet.Name & ".txt", _
FileFormat:=xlText, CreateBackup:=False
Next ws
'Close out the workbook now
ActiveWorkbook.Close
End Sub

Converting Formulas in Multiple Worksheets to Values

The below VBA code is intended to convert formulas in multiple worksheets to values, then save a copy of the workbook in the specified directory.
I'm trying to copy paste value only, but the workbook still saves with formulas in these sheets. I don't know what I did wrong,this code doesn't seem to work
Sub CREATE4SHEETS()
Sheets(Array("sheet1", "sheet3", "sheet6", "sheet7", "sheet8", "sheet10")).Select
Sheets("sheet10").Activate
Sheets(Array("sheet1", "sheet3", "sheet6", "sheet7", "sheet8", "sheet10")).Copy
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ChDir "\\mac\desktop\" ' Name folder
ActiveWorkbook.SaveAs Filename:= _
"\\Mac\Desktp\newworkbook.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' need to change the name of the folder
ActiveWorkbook.Save
End Sub
It seems that
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
is not working as supposed to. Does anyone know why? thanks!
The below modified code will convert any formulas in the indicated worksheets to values, then save the workbook with the specified filename.
Sub CREATE4SHEETS()
Dim WS as Worksheet
Application.DisplayAlerts = False
'For each WS in Sheets(Array("sheet1", "sheet3", "sheet6", "sheet7", "sheet8", "sheet10"))
' WS.UsedRange.Value2 = WS.UsedRange.Value2
'Next WS
For each WS in Worksheets
If (UBound(Filter(Array("sheet1", "sheet3", "sheet6", "sheet7", "sheet8", "sheet10"), WS.Name)) > -1) Then
'Keep this worksheet
WS.UsedRange.Value2 = WS.UsedRange.Value2
Else
WS.Delete
End If
Next WS
Set WS = Nothing
ActiveWorkbook.SaveAs Filename:= _
"\\Mac\Desktp\newworkbook.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ' need to change the name of the folder
Application.DisplayAlerts = True
End Sub

Rebuild a workbook with VBA

I am trying to run the below VBA that I found online. The purpose of the code is to copy the data from all of the worksheets in a workbook to a different workbook. A couple key points:
1) I am trying to copy the data in all worksheets NOT the actual worksheets to the new workbook
2) The macro does a lot: makes sure you have a back-up file; creates a new worksheet (TargetWorkbook) and saves with the source workbook's name; etc. however, the most important part (and where I believe it is erroring) is copying the worksheets
3) I understand what is going on with the code but not savvy enough to make it work.
Sub Update_SmartView_Workbook()
' Copies sheets from a source workbook to new and current Excel target workbook to
' get rid of the "2003 or earlier backbone" that interferes with SmartView.
' Keyboard Shortcut: Ctrl+z
' Copyleft 2013 By MJ Henderson. No rights reserved. Free and worth every penny.
' User assumes all risk. No warranties implied or otherwise.
Dim ConfirmBackup As Integer
Dim SourceWorkbook, TargetWorkbook As Workbook
Dim SourceWorksheet As Worksheet
Dim SourceWorkbookName As String
' User must make a backup before proceeding.
ConfirmBackup = MsgBox("Have you made a backup copy of the source file?", vbYesNo, "Confirm Backup")
If ConfirmBackup = vbNo Then
MsgBox "Try again when you have a backup copy of the source file", vbOKOnly, "Backup Required"
Exit Sub
End If
' Find and open the source file
Application.FindFile
Set SourceWorkbook = ActiveWorkbook
SourceWorkbookName = ActiveWorkbook.Name
SourceWorkbookDirectoryPath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(SourceWorkbookName))
' Create a new target workbook in the same folder as the source workbook
Workbooks.Add
ActiveWorkbook.SaveAs _
Filename:=SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx", _
FileFormat:=xlOpenXMLWorkbook, ConflictResolution:=True
' Copy each worksheet in SourceWorkbook to TargetWorkbook THIS IS WHERE THE FIX IS NEEDED
SourceWorkbook.Activate
For Each SourceWorksheet In SourceWorkbook.Worksheets
SourceWorksheet.Cells.Copy
Windows("TargetWorkbook.xlsx").Activate
ActiveWindow.WindowState = xlNormal
On Error Resume Next
TargetWorkbook.Sheets(SourceWorksheet.Name).Delete
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
ActiveSheet.Name = SourceWorksheet.Name
Application.CutCopyMode = cancel
Next
' Close SourceWorkbook, rename SourceWorkbook with suffix "_OLD"
SourceWorkbook.Activate
SourceWorkbook.Saved = True
SourceWorkbook.Close SaveChanges:=False
Name SourceWorkbookDirectoryPath & SourceWorkbookName As SourceWorkbookDirectoryPath & SourceWorkbookName & "_OLD"
' Global replace to remove any references to old workbook. (Fixes interbook links.)
Cells.Replace What:="[" & SourceWorkbookName & "]", _
Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
' Rename TargetWorkbook as SourceWorkbook's original name, delete TargetWorkbook
TargetWorkbook.Activate
ActiveWorkbook.SaveAs _
Filename:=SourceWorkbookDirectoryPath & SourceWorkbookName, _
FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Saved = True
ActiveWorkbook.Close SaveChanges:=False
Kill SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx"
End Sub
I believe these lines are driving the error:
Windows("TargetWorkbook.xlsx").Activate
ActiveWindow.WindowState = xlNormal
The error I am getting is "Run Time Error 9 - Subscript out of Range"
Any idea on how to fix?
Use Workbooks("TargetWorkbook.xlsx").Activate instead of Windows...
I would recommend to eliminate the activating if the sheet and workbooks; we do not need it. Just referencing the object is enough.
This is an untested code see how it goes you might need to change it a little bit to fit your needs.
Option Explicit
Sub Test()
Dim ConfirmBackup As Integer
Dim SourceWorkbook, TargetWorkbook As Workbook
Dim SourceWorksheet As Worksheet
Dim SourceWorkbookName As String
Dim SourceWorkbookDirectoryPath As String
' User must make a backup before proceeding.
ConfirmBackup = MsgBox("Have you made a backup copy of the source file?", vbYesNo, "Confirm Backup")
If ConfirmBackup = vbNo Then
MsgBox "Try again when you have a backup copy of the source file", vbOKOnly, "Backup Required"
Exit Sub
End If
' Find and open the source file
Application.FindFile
Set SourceWorkbook = ActiveWorkbook
SourceWorkbookName = ActiveWorkbook.Name
SourceWorkbookDirectoryPath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(SourceWorkbookName))
' Create a new target workbook in the same folder as the source workbook
Workbooks.Add
ActiveWorkbook.SaveAs _
Filename:=SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx", _
FileFormat:=xlOpenXMLWorkbook, ConflictResolution:=True
' Copy each worksheet in SourceWorkbook to TargetWorkbook THIS IS WHERE THE FIX IS NEEDED
For Each SourceWorksheet In SourceWorkbook.Worksheets
TargetWorkbook.Sheets(SourceWorksheet.Name).Delete
SourceWorksheet.Copy After:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count)
Next
' Close SourceWorkbook, rename SourceWorkbook with suffix "_OLD"
SourceWorkbook.Close SaveChanges:=True
Name SourceWorkbookDirectoryPath & SourceWorkbookName As SourceWorkbookDirectoryPath & SourceWorkbookName & "_OLD"
' Global replace to remove any references to old workbook. (Fixes interbook links.)
Cells.Replace What:="[" & SourceWorkbookName & "]", _
Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
' Rename TargetWorkbook as SourceWorkbook's original name, delete TargetWorkbook
ActiveWorkbook.SaveAs _
Filename:=SourceWorkbookDirectoryPath & SourceWorkbookName, _
FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close SaveChanges:=True
Kill SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx"
End Sub
I hope it helps